Commit of 3.99.0 version
This commit is contained in:
Erick Gallesio
parent
831a9f5c47
commit
5f74a25a3c
|
|
@ -1,4 +1,4 @@
|
|||
Binary distributions are available at ftp://kaolin.unice.fr/pub/Binary.
|
||||
Binary distributions are available at ftp://kaolin.unice.fr/pub/STk/Binary.
|
||||
If you succeed in compiling a version for which no binary is available
|
||||
on the previous site, you can probably help other people by sharing
|
||||
your binary.
|
||||
|
|
@ -8,7 +8,7 @@ To make a machine-specific binary:
|
|||
2. Create a README file for your distribution which indicates
|
||||
the options you chose. A model of the README file is given below.
|
||||
3. Place the binary archive (the .tar.gz) and the README file in
|
||||
ftp://kaolin.unice.fr/pub/Incoming/
|
||||
ftp://kaolin.unice.fr/pub/STk/Incoming/
|
||||
|
||||
Thanks
|
||||
|
||||
|
|
|
|||
116
CHANGES
116
CHANGES
|
|
@ -1,3 +1,117 @@
|
|||
04/10/98 Release 3.99.0
|
||||
-----------------------
|
||||
|
||||
This is the pre-4.0 release. Why is is not calles 4.0? Good question.
|
||||
This version would have been numbered 4.0 if there was not a so long
|
||||
time between this release and the previous one. Since I take so long
|
||||
to release, I had time to add a lot of things to my "TODO list".
|
||||
And this version misses some things that I consider important (even if
|
||||
not visible form outside) to be called 4.0. Furthermore, ther is a big
|
||||
absent since last release which is the port on Windows. The real 4.0
|
||||
will have support for Windows.
|
||||
|
||||
Here are the main visible changes from previous release:
|
||||
|
||||
About Scheme
|
||||
|
||||
* A module system has been added
|
||||
* Integration of the Bigloo MATCH-CASE and MATCH-LAMBDA
|
||||
primitives. Furthermore, the file bigloo.stk provide
|
||||
some compatibility between STk and bigloo modules.
|
||||
* A simple FFI has been added. It allows to access C
|
||||
functions without writing C code (works only on a
|
||||
limited set of architectures for now).
|
||||
* integrates the R5RS VALUES and CALL-WITH-VALUES
|
||||
* multi-line comments have been added.
|
||||
* The "-file" interpreter option is no more necessary
|
||||
* Display of the prompt and of the eval result in the
|
||||
REPL are now user definable.
|
||||
* report-error mechanism has been enhanced a lot (work
|
||||
is not completely achieved).
|
||||
* new-primitives: append!, mast-pair, C-string->string,
|
||||
remove-file, rename-file, temporary-file-name, ...
|
||||
* Numerous bug corrections
|
||||
* ...
|
||||
|
||||
About Tk
|
||||
|
||||
* Integration of the Tk8.0 toolkit
|
||||
* The old inspector has been adapted to work with
|
||||
current release (not completely, but sufficiently
|
||||
while the new version is terminated)
|
||||
* Buttons, Checkbuttons and Radiobuttons can use a
|
||||
:variable and :textvariable in a given environment.
|
||||
This environment is given with the new :environment
|
||||
option.
|
||||
* New metaclass: <Tk-composite-toplevel>. This is
|
||||
identical to the class <Tk-composite-widget>, except
|
||||
that the widhet lives in its own toplevel window.
|
||||
* make-image simplifies the usage of Tk images and uses
|
||||
a cache, to speed-up access to already used images.
|
||||
* The little square window, which used to appear as soon
|
||||
as STk was launched, appears now only when the first
|
||||
widget is mapped on screen.
|
||||
* ...
|
||||
|
||||
About STklos
|
||||
|
||||
* The MOP of STklos is now very similar to the CLOS one.
|
||||
Here are some of the new features:
|
||||
o when a slot does not exists, the gf slot-missing
|
||||
is called
|
||||
o when a unbound slot is read, the gf slot-unbound
|
||||
is called
|
||||
o new generic functions slot-ref-using-class,
|
||||
slot-set-using-class, slot-bound-using-class?,
|
||||
slot-exists-using-class?, slot-definition-name,
|
||||
slot-definition-options,
|
||||
slot-definition-allocation,
|
||||
slot-definition-getter, slot-definition-setter,
|
||||
slot-definition-accessor, generic-function-name,
|
||||
generic-function-methods,
|
||||
method-generic-function, method-specializers
|
||||
method-procedure, remove-method
|
||||
change-object-class
|
||||
* New kind of slot allocation: "active". An active slot
|
||||
is a slot for which you can put a daemon before or
|
||||
after its reading/writing
|
||||
* Standard behavior of class slots is now identical to
|
||||
CLOS: when a class-slot is inherited, it is shared
|
||||
with instances of the superclass. If it is redefined,
|
||||
a new slot is created
|
||||
* slot initializers are evaluated in the lexical
|
||||
environment of the class definition.
|
||||
* (Tk-)virtual slots can now have an :initform option.
|
||||
* Generic functions can be now traced with the standard
|
||||
TRACE function.
|
||||
* Composite widgets have now a class slots which
|
||||
contains the class of the object. This slot is
|
||||
initialized by default to "Composite", but it can be
|
||||
overloaded for a particular class. For instance
|
||||
labeled entries use the value "LabeledEntry" by
|
||||
default. This feature can be used for initializing the
|
||||
X11 resource database. for instance you can have
|
||||
STk*LabeledEntry*Entry*Background: white in your
|
||||
.Xdefaults file to set the default value of background
|
||||
of the entry of a <Labeled-entry> widget.
|
||||
* New composites widgets: Gauge, Valued-Gauge,
|
||||
Balloon-help
|
||||
* The HTML-browser has been enhanced to access now the
|
||||
web (i.e. you can grab distant texts or images). The
|
||||
Web browser admit now applets written in Scheme.
|
||||
* New kind of slot allocation: "active". An active slot
|
||||
is a slot for which you can put a daemon before or
|
||||
after its reading/writing
|
||||
* extended types (defined in C) are now automatically
|
||||
integrated in the STklos hierarchy.
|
||||
* Several new classes for displaying messages boxes
|
||||
* New class <Color-box> for choosing colors.
|
||||
* New <Tk-Text-inset>. This class is the now the parent
|
||||
class of <Text-window> and of (the new) class
|
||||
<Text-image>.
|
||||
* ...
|
||||
|
||||
|
||||
09/26/96 Release 3.1.1
|
||||
----------------------
|
||||
|
||||
|
|
@ -240,4 +354,4 @@ This is a major release version.
|
|||
93/09/02 Release 1.00 (first public release)
|
||||
~~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
Forget it :)
|
||||
Forget it :)
|
||||
|
|
|
|||
758
ChangeLog
758
ChangeLog
|
|
@ -1,3 +1,758 @@
|
|||
Fri Apr 10 09:01:17 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STk-3.99.0 release
|
||||
|
||||
Wed Apr 8 17:02:26 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/*.c: Correction: stderr (instead of STk_stderr) was incorrectly
|
||||
used in some places.
|
||||
|
||||
* Src/Stack: Code was absolutely incorrect for machine which don't
|
||||
support FFI.
|
||||
|
||||
Sun Mar 22 15:05:47 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STk/port.c: load accepts now (again) a module as optionnal
|
||||
parameter
|
||||
|
||||
Mon Mar 9 21:42:08 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Lib/www-html.stk: Code for applet in S-scape polished.
|
||||
|
||||
* Src/tcl-glue: Bug correction in STk_valid_environment
|
||||
|
||||
* Tcl/tclEvent.c: Bug correction: after events callback table was
|
||||
not correctly cleaned when an event was fired.
|
||||
|
||||
Sun Mar 8 23:41:11 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/cont.c: Addition of R5RS values
|
||||
|
||||
Sun Mar 1 11:53:40 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Lib/www*: The Web Browser has been rewriten.
|
||||
|
||||
Sat Feb 28 12:37:29 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/gc.c: Bug correction: Error context was improperly reset
|
||||
when an error occurs in catch.
|
||||
|
||||
Fri Feb 27 01:07:50 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/unix.c: Three new functions on file: remove-file,
|
||||
rename-file temporary-file-name. They correspond to their
|
||||
equivalent in the ANSI C norm.
|
||||
|
||||
Tue Feb 24 18:56:17 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Demos/Widget/*.stklos: All the widget demo are now implemented.
|
||||
|
||||
* STklos/Tk/Text.stklos: New <Tk-Text-inset>. This class is the
|
||||
now the parent class of <Text-window> and of (the new) class
|
||||
<Text-image>.
|
||||
|
||||
* Tk/generic/tkConfig.c: a lot of change to take image as a real
|
||||
type (instead of a string). Configuration has been cleaned.
|
||||
|
||||
Thu Feb 19 16:39:46 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Demos/stetris.stk (new-game): replaced an after which use a pre
|
||||
STk-3.0 after bindind (i.e. an after with a list) by a
|
||||
lambda. This cause problem with module environment (the first one
|
||||
I see since a long time). This could have been resolved by
|
||||
makeing Tk importing STklos+Tk. But there is no good reason to do
|
||||
so. The bad news is that very old code can be broken if it uses
|
||||
list bindings instead of lambda (it's more than 2 years than this
|
||||
form is deprecated) and STklos.
|
||||
|
||||
Thu Feb 12 16:17:36 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Demos/stklos-widgets.stklos: Updated to take into account new
|
||||
composite widgets.
|
||||
|
||||
* Src/port.c: read-line now skips the '\r' characters.
|
||||
|
||||
Sun Feb 8 20:59:34 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Tk/generic/tkScale.c (ScaleVarProc): New option :ENVIRONMENT
|
||||
* Tk/generic/tkMessage.c (ConfigureMessage): New option :ENVIRONMENT
|
||||
|
||||
* Src/error.c: Cleanup (one more time :-<)
|
||||
|
||||
Mon Feb 2 22:47:52 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STklos/Tk/Composite/Colorbox.stklos: New class <Color-box>, and its
|
||||
user function Tk:choose-color.
|
||||
|
||||
|
||||
Sun Feb 1 19:16:46 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Lib/tk-unix.stk: New file for the definition of standard messages
|
||||
box. They are simulated on Unix and will be natve (someday) on Windows.
|
||||
|
||||
|
||||
* STklos/Tk/MsgBox.stklos: New Classes: <Tk-message-box>
|
||||
<Abort-retry-ignore-message-box> <Ok-message-box>
|
||||
<Ok-cancel-message-box> <Ok-cancel-message-box>
|
||||
<Retry-cancel-message-box> <Yes-no-message-box>
|
||||
<Yes-no-cancel-message-box>. This classes are used by the
|
||||
new function Tk:message-box to build mesages boxes.
|
||||
|
||||
* Src/read.c: Now #. is evaluated in the current module (instead
|
||||
of the global one).
|
||||
|
||||
* Src/tcl-glue.c (STk_convert_Tcl_string2list): current module is
|
||||
set to the Tk module when converting a Tk result to Scheme. This
|
||||
is mainly for "#." expression which must be evaluated in the Tk
|
||||
module since all the side effects done by Tk are done in it.
|
||||
|
||||
|
||||
Thu Jan 29 19:21:48 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STklos/Tk/Composite/Choicebox.stklos: New slot for
|
||||
<Choice-box>es: CHOICE. This slot contains the set of possible
|
||||
values for the entry.
|
||||
|
||||
|
||||
Mon Jan 26 15:42:11 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STklos/Tk/Tk-meta.stklos: Protocol for widget has been
|
||||
"lighted". The slot tk-valid-option has ben deleted and slot are
|
||||
set one by one after class initialization. This in in fact faster
|
||||
than the old method. However <Frame> and <Toplevel> classes, don't
|
||||
fit well in this scheme (some of their slots cannot be changed
|
||||
after the widget is created (e.g. class or visual) => There is a
|
||||
spcial init function for theses classes.
|
||||
|
||||
* STklos/Tk/Basics.stklos: Composite widgets have now a class
|
||||
slots which contains the class of the object. This slot is
|
||||
initialized by default to "Composite", but it can be overloaded
|
||||
for a particular class. For instance labeled entries use the value
|
||||
"LabeledEntry" by default. This feature can be used for
|
||||
initializing the X11 resource database. for instance you can have
|
||||
|
||||
STk*LabeledEntry*Entry*Background: white
|
||||
|
||||
in the .Xdefaults file to set the default value of background of
|
||||
the entry of a <Labeled-entry> widget.
|
||||
|
||||
* STklos/Tk/Basics.stklos: :tk-virtual slots accept now the
|
||||
:init-form option. That means that you can do new classes which
|
||||
simply change the default value by subclassing a previous widget
|
||||
class.
|
||||
|
||||
* STklos/Tk/Frame.stklos: Change in the STklos hierarchy:
|
||||
<Toplevel> inherits now from <Frame>. They were separate classes
|
||||
before.
|
||||
|
||||
Sun Jan 25 10:53:54 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/toplevel.c:
|
||||
* Lib/init.stk: User initialization file (.stkrc) is now loaded
|
||||
after Tk is initialized. It used to be initialized at the end of
|
||||
init.stk (and hence just before Tk). File loading is done in C.
|
||||
now.
|
||||
|
||||
Sat Jan 24 13:22:51 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STklos/stklos.stk: Bug correction in METHOD.
|
||||
|
||||
* STklos/describe.stk: renamed to STklos/describe.stklos
|
||||
* STklos/active.stk: renamed to STklos/active.stklos
|
||||
|
||||
Thu Jan 22 23:50:38 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Lib/init.stk: New macro: DEFINE-VARIABLE. It's equivalent to the
|
||||
Elisp/CL DEFVAR
|
||||
|
||||
* Lib/tk-init.stk (*start-withdrawn*): A lot of people dislike the
|
||||
fact that the root window is mapped on screen when Tk is started,
|
||||
The code below, unmaps the *root* window and make it appearing as
|
||||
soon as the first sub-window is packed or some action is asked to
|
||||
the window manager for *root*. With this code, the the behaviour
|
||||
is identical to the Tk original one except that the empty squared
|
||||
window don't appears on screen. The original behaviour can be
|
||||
recovered by setting *start-withdrawn* to #f
|
||||
|
||||
Tue Jan 20 14:40:31 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/proc.c: New undoumented procedure: %procedure-arity
|
||||
|
||||
* STklos/stklos.stk:
|
||||
* Src/stklos.c: Optimisation of slot accesses for virtual
|
||||
slots. The call to APPLY is now inlined in the slot-ref and
|
||||
slot-set! functions. The arity of the setter and getter functions
|
||||
is now verified at class creation (rather than slot access, in
|
||||
some extent). The only drawback is that the getter and setter
|
||||
function must be closures now, whereas they could be generic
|
||||
funtions or primitives before (but I cannot imagine how it could
|
||||
be used).
|
||||
|
||||
Sun Jan 18 20:06:00 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STklos/trace-gf.stklos: New file for tracing generic functions.
|
||||
* Lib/trace.stk: Trace has been updated and take into account
|
||||
generic functions now.
|
||||
|
||||
Tue Jan 13 10:13:22 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Lib/dialog.stk: Correction of bug signaled by Fritz
|
||||
Heinrichmeyer <fritz.heinrichmeyer@fernuni-hagen.de>
|
||||
|
||||
Fri Jan 9 21:06:22 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/port.c: Bug correction in "AUTOLOAD?". BTW, this function
|
||||
admit now a (optional) second parameter which can be a module.
|
||||
|
||||
* Src/syntax.c:
|
||||
* Src/env.c:
|
||||
* Src/module.c: Bug correction for C varaiables which were
|
||||
"disconnected" of their C counterpart in some cases
|
||||
|
||||
Thu Jan 8 12:27:44 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/stklos.c: New slot for generic functions: "module"
|
||||
|
||||
Sat Jan 3 16:50:55 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STk.prj: STk.prj has been completely redefines. Now PRCS
|
||||
versions are in sync with STk version.
|
||||
|
||||
Thu Jan 1 13:18:22 1998 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/dynload.c: New function: EXTERNAL-EXISTS? to determine if a
|
||||
symbol is defined in a library.
|
||||
|
||||
Wed Dec 31 15:37:36 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/hash.c (hash_table_put) Bug correction: code was not GC
|
||||
safe. Thanks to Sarah Calvo <sarah@grammatech.com>
|
||||
|
||||
Tue Dec 30 23:33:09 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Extensions/posix.c: Integration of several new functions given
|
||||
by Shiro Kawai <shiro@sqush.squareusa.com>
|
||||
|
||||
* Src/argv.c: The way arguments are processed has been changed:
|
||||
now the first argument is taken as a script name (unless there was
|
||||
already a -file option specified). Furthermore, when the -file
|
||||
option is used (implicitly or explicitly), the variable
|
||||
*program-name* is set to the name of the script file (instead of
|
||||
the file name of the interpreter).
|
||||
|
||||
* Doc/Manual/stk.1: Adaptation of the man page for the new
|
||||
conventions for argument passing to the interpreter (-file option
|
||||
and implicit -file).
|
||||
|
||||
* Src/eval.c:
|
||||
* Src/error.c: Bug correction: In some circumstances a buggy
|
||||
REPORT-ERROR can lead to an infinite loop. Now we can have the
|
||||
stack when in report-error AND the original error which caused the
|
||||
execution of the report-error procedure.
|
||||
|
||||
Sun Dec 28 21:44:01 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Lib/Match/normalize.scm:
|
||||
* Lib/Match/compiler.scm:
|
||||
* Lib/Match/descr.scm: Adaptation for STk.
|
||||
|
||||
|
||||
Mon Dec 22 00:00:54 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Doc/Reference/Appendix.tex: New Appendix which describes the
|
||||
main differences between STk versions.
|
||||
|
||||
* Src/extend.c: POINTER->STRING has been moved to file dynload.c
|
||||
and renamed C-STRING->STRING since ita accepts pointers AND
|
||||
strings now.
|
||||
|
||||
Mon Dec 15 13:53:46 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/print.c: Cosmetic change: When a procedure is writen, it
|
||||
displays its argument list. This is helpful when debugging
|
||||
|
||||
* Src/number.c: Two new function for dealing with unsigned C
|
||||
numbers: long STk_integer2long(SCM x); unsigned long
|
||||
STk_integer2ulong(SCM x);
|
||||
|
||||
* Src/extend.c: New primitive C-POINTER->STRING. This procedure
|
||||
converts a C-pointer to a string. An optionnal length can be
|
||||
given.
|
||||
|
||||
Sat Dec 13 11:07:46 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/stklos.c:
|
||||
* Src/slib.c:
|
||||
* Src/port.c:
|
||||
* Src/gc.c: Correction of various bugs signalled by Walter C. Pelissero
|
||||
<wcp@luppolo.lpds.sublink.org>
|
||||
|
||||
* Src/syntax.c: Bug correction in definition of internal variables
|
||||
|
||||
Wed Dec 10 23:25:21 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/signal.c (handle_sigsegv_signal): new procedure. This
|
||||
procedure is called when a SIGSEGV is called. This avoid an
|
||||
infinite loop when a real SIGSEGV occurs. It just go to the
|
||||
toplevel (if the signal has not been redirected)
|
||||
|
||||
Sun Dec 7 22:01:54 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* configure.in: Take into account the new libc (Gnu libc) for
|
||||
Linux.
|
||||
|
||||
Wed Nov 19 09:34:22 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Cleaning code of environment allocation. There is now a new type
|
||||
for frame cells (tc_frame). For now this type is equivalent to a
|
||||
cons, but it allows future optimization on environment allocation.
|
||||
|
||||
Thu Nov 13 01:10:41 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/proc.c:
|
||||
* Src/gc.c:
|
||||
* Src/eval.c:
|
||||
* Src/syntax.c: Cleaning of procedure creation code. All
|
||||
closures are created by the function STk_makeclosure
|
||||
(instead of being inlined in code).
|
||||
|
||||
* Src/syntax.c:
|
||||
* Src/env.c: Correction of a long standing bug with internal
|
||||
defines management. In some cases, access to local variable could
|
||||
be false. This was because new variables were inserted at the
|
||||
beginning of the environment instead of the end.
|
||||
|
||||
* Extensions/process.c (free_process): Standard ports were freed
|
||||
instead of closed when a process was deallocated. Bug discovered
|
||||
by Sarah Calvo <sarah@grammatech.com>
|
||||
|
||||
|
||||
Wed Nov 12 09:35:13 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/list.c: new primitve: the R3RS last-pair
|
||||
|
||||
Sun Nov 9 22:01:56 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/list.c:
|
||||
* Src/primitives.c: New primitive: append!
|
||||
|
||||
Tue Oct 28 21:24:02 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Lib/match.stk: Integration of the Bigloo MATCH-CASE and MATCH-LAMBDA
|
||||
primitives
|
||||
|
||||
Tue Oct 7 09:46:46 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Extensions/posix.c (posix_stat2vector): bug correction (GC
|
||||
problems)
|
||||
|
||||
* Src/proc.c (STk_for_each): minor bug correction: return an
|
||||
undefined result instead of NIL as before.
|
||||
|
||||
* Lib/posix.stk: Two new functions POSIX-STAT->LIST and
|
||||
POSIX-LSTAT which make easier the use of stat function (they
|
||||
return a keyworded list instead of a (cryptic) vector.
|
||||
|
||||
Wed Sep 17 15:39:54 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Lib/tk-init.stk: New variable *image-path* which contains path
|
||||
for loading images.
|
||||
|
||||
Tue Sep 16 16:29:51 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/tcl-lib.c (Tcl_OpenFileChannel): build an error message when
|
||||
file cannot be opened. This is now done in Tcl. Note that the
|
||||
Tk8.0 code is not consistent here since it exists places where the
|
||||
check against NULL is done and other where it is supposed that Tcl
|
||||
fill the error message!!!!
|
||||
|
||||
Sun Sep 14 11:22:48 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STklos/Tk/Basics.stklos: New metaclass:
|
||||
<Tk-composite-toplevel>. This is identical to the class
|
||||
<Tk-composite-widget>, except that the widhet lives in its own
|
||||
toplevel window. Furthermore, this widget has a slot called TITLE
|
||||
which contains the title of the widget window.
|
||||
|
||||
*STklos/Tk/*.stklos: added a "(select-module Tk) in all these files
|
||||
|
||||
Sat Sep 6 22:07:39 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/toplevel.c: names of display-prompt and display-result have
|
||||
been changed to repl-display-prompt and repl-display-result
|
||||
|
||||
Wed Sep 3 18:18:45 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STklos/Tk/Basics.stklos:
|
||||
* STklos/Tk/Button.stklos:
|
||||
* STklos/Tk/Menu.stklos: Addition of new Tk8.0 slots
|
||||
|
||||
Fri Aug 29 12:17:58 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Lib/tearoff.stk: File deleted. It is now included in menu.stk
|
||||
|
||||
Wed Aug 27 15:46:25 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Mp/Makefile: Path was incorrect when using fgmp.
|
||||
|
||||
* Src/stklos.c:
|
||||
* Src/tk-main.c: Gc_protect is no more useful on modules since a
|
||||
module is always accessible from the module table.
|
||||
|
||||
* Src/tcl-lib.c: Simulation of the new function
|
||||
"Tcl_DeleteCommandFromToken" used by the final Tk8.0
|
||||
|
||||
Mon Aug 25 12:27:11 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Start of port for final Tk8.0.
|
||||
|
||||
* Src/module.c:
|
||||
* Src/primitives.c: Modules are now stored in a private table
|
||||
instead of bound in the global space. The new primitive
|
||||
FIND-MODULE queries the module table to find a given module
|
||||
(modules are still first-class objects).
|
||||
|
||||
* Tk/generic/tkWindow.c: Reverted the command "tk-state" to "tk"
|
||||
since the module names are no more bound in global space.
|
||||
|
||||
Sun Aug 24 17:10:00 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/module.c: There is now a module which is created when the
|
||||
interpreter is initialized. This module (named Scheme) exports
|
||||
all initial bindings (mainly primitives) defined when the
|
||||
interpreter starts. So, even when the user overload a standard
|
||||
primitive, the initial bindings can be found in the Scheme module.
|
||||
|
||||
|
||||
Wed Aug 20 14:02:06 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Doc/Makefile: Installation of manual pages even if the
|
||||
documentation is not requested.
|
||||
|
||||
Mon Aug 18 11:50:32 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Doc/Manual/label.n:
|
||||
* Doc/Manual/grid.n:
|
||||
* Doc/Manual/frame.n:
|
||||
* Doc/Manual/font.n:
|
||||
* Doc/Manual/event.n:
|
||||
* Doc/Manual/entry.n:
|
||||
* Doc/Manual/destroy.n:
|
||||
* Doc/Manual/checkbutton.n:
|
||||
* Doc/Manual/button.n:
|
||||
* Doc/Manual/canvas.n:
|
||||
* Doc/Manual/bind.n:
|
||||
* Doc/Manual/bindtags.n: Documentation update for Tk8.0
|
||||
|
||||
Sun Aug 17 23:47:09 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STklos/Tk/Basics.stklos: New class <Tk-environment> for the
|
||||
widget which have a "text-variable" or "variable" slot (Button,
|
||||
Checkbutton, Entry, ...) The corresponding widget have been
|
||||
changed to take into account this new class.
|
||||
|
||||
Sat Aug 16 16:28:55 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Tk/generic/tkButton.c: Buttons, Checkbuttons and Radiobuttons
|
||||
can use a :variable and :textvariable in a given environment. This
|
||||
environment is given with the new :environment option.
|
||||
|
||||
Wed Aug 13 17:21:08 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/error.c: The variables *last-error-message* and
|
||||
*last-error-arg* are set hen an error occurs. This is useful to
|
||||
find what error occured when errors are catched. This is also
|
||||
needed by Envdraw.
|
||||
|
||||
Tue Jul 8 10:00:26 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* New type in the interpreter: tc_tclobjet. This type is necessary
|
||||
to simulate the Tcl "Tcl_Obj" type. Tcl_Obj is a crazy thing.
|
||||
Why Tcl does not use a GC, and life would be a *lot* easier (for me
|
||||
but for them too...)
|
||||
|
||||
Mon Jul 7 09:59:49 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Start of Tk8.0 integration
|
||||
|
||||
Mon Jun 23 19:43:36 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STklos/stklos.stk (class-subclasses): rewritten. It was too slow.
|
||||
|
||||
Sun Jun 1 11:20:21 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STklos/stklos.stk: (Tk-)virtual slots can now have an
|
||||
:initform option.
|
||||
|
||||
Fri May 23 16:07:01 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/stklos.c (build_initializers): build_initializers takes now
|
||||
one more parameter (the environment in which the class has been
|
||||
defined) Consequently, initializer are evaluated in the lexical
|
||||
environment of the class definition.
|
||||
|
||||
* STklos/stklos.stk (compute-get-n-set): Standard behavior of class
|
||||
slots is now identical to CLOS: when a class-slot is inherited, it
|
||||
is shared with instances of the superclass. If it is redefined,
|
||||
a new slot is created
|
||||
|
||||
Thu May 15 18:04:50 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Lib/inspect-*.stk: Adaptation of the old inspector for the
|
||||
STk-3.x release. This is incomplete but it can be use until the
|
||||
Rigth Thing is finished. All the adaptation was done by Brian
|
||||
Denheyer <briand@northwest.com>. Thanks to him.
|
||||
|
||||
* Src/proc.c (general_map): map was buggy with a null list of
|
||||
argument (map +) gave a core dump!
|
||||
|
||||
Thu May 8 11:28:11 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/port.c: Go back: LOAD and TRY-LOAD don't use anymore the
|
||||
environment parameter. In fact loading a file is done in the
|
||||
current module now rather at the global level as before.
|
||||
|
||||
* Tcl/tclUtil.c (Tcl_DStringStartSublist, Tcl_DStringEndSublist):
|
||||
braces replaced by parentheses (bug signaled by Vincent Granet
|
||||
<vg@unice.fr>)
|
||||
|
||||
Sun Apr 6 15:07:20 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/port.c: File loading: LOAD and TRY-LOAD accept now an
|
||||
optional second argument. This argument must be an environment
|
||||
which states in which environment the file must be loaded.
|
||||
|
||||
Fri Apr 4 14:49:15 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Lib/error.stk: Minor fix in the layout of display environment
|
||||
windows.
|
||||
|
||||
Thu Mar 27 15:32:28 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/toplevel.c (repl_loop): The interactive prompt is no more a
|
||||
constant. In fact, when the prompt must be displayed, we try to
|
||||
apply the thunk contained in the *prompt* global symbol (*prompt*
|
||||
must be a thunk). If an error occurs during this application, the
|
||||
usual "STk> " prompt is displayed.
|
||||
|
||||
* Lib/init.stk: Adding a default *prompt* closure in the startup file
|
||||
|
||||
Sun Mar 23 19:57:07 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/toplevel.c (repl_driver): in the toplevel repl, the result is
|
||||
not displayed if we are not in interactive mode (suggested by a mail
|
||||
from Jesse Schell <jns@ishmael>)
|
||||
|
||||
Fri Mar 14 14:00:51 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/list.c (STk_append2): The old private append2 is now public
|
||||
since it is often used in the interpreter. Part of it using
|
||||
STk_append have been modified.
|
||||
|
||||
Fri Feb 28 10:43:41 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/read.c: New feature: multi lines comments
|
||||
(as in Common Lisp: #| ... |# )
|
||||
|
||||
* Src/stklos.c (STk_init_STklos): New MOP procedures
|
||||
generic-function-name
|
||||
generic-function-methods
|
||||
method-generic-function
|
||||
method-specializers
|
||||
method-procedure
|
||||
remove-method
|
||||
change-object-class
|
||||
|
||||
Sun Feb 23 23:08:40 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STklos/stklos.stk: New MOP procedures
|
||||
slot-definition-name
|
||||
slot-definition-options
|
||||
slot-definition-allocation
|
||||
slot-definition-getter
|
||||
slot-definition-setter
|
||||
slot-definition-accessor
|
||||
|
||||
* Src/stklos.c: Instances type is now in the cell. This decreases
|
||||
globally the size of a STklos instance of the size of one int.
|
||||
|
||||
* Two new classes: <simple-method> and <accessor-method>.
|
||||
A <simple-method> is a method which cannot be call next_method.
|
||||
<Accesor-method>s are used for defining slot-readers and writers.
|
||||
Application of these methods are faster than normal method
|
||||
since the next-method object is not constructed.
|
||||
|
||||
Mon Jan 20 15:59:24 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STklos/stklos.stk (object-equal?): has been redefined to call
|
||||
eqv? rather than returning #f. This is the same thing except that
|
||||
when you redefine eqv?, it automatically redefine equal?.
|
||||
Furthermore, it is more coherent with standard Scheme eqv? and equal?
|
||||
|
||||
Sat Jan 4 00:45:37 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STklos/describe.stk: New DESCRIBE method for generic functions.
|
||||
Modification of DESCRIBE method for classes to take into account new
|
||||
class slots (specializers and initializers are no more displayed)
|
||||
|
||||
* Src/stklos.c:
|
||||
STklos/stklos.stk:
|
||||
Modifications
|
||||
- when a slot does not exists, the gf slot-missing is called
|
||||
- when a unbound slot is read, the gf slot-unbound is called
|
||||
New primitives
|
||||
- slot-ref-using-class
|
||||
- slot-set-using-class
|
||||
- slot-bound-using-class?
|
||||
- slot-exists-using-class?
|
||||
|
||||
* STklos/stklos.stk (change-class): change-class didn't
|
||||
initialize the slots added to the instance. This is done
|
||||
now (but this is a little bit different from CLOS: unbound
|
||||
slots in the "old" instances are initialized with the initform
|
||||
value in the "new" instance, whereas they remain unbound
|
||||
in CLOS).
|
||||
|
||||
Wed Jan 1 11:44:45 1997 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/toplevel.c: Modification of copyright dates (we are (just) in
|
||||
1997 now).
|
||||
|
||||
Mon Dec 30 10:08:19 1996 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STklos/stklos.stk: STklos does not need hash table anymore.
|
||||
|
||||
Sun Dec 29 22:24:24 1996 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/port.c (STk_autoloadp): Bug correction.
|
||||
|
||||
Mon Dec 23 12:05:35 1996 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/io.c: old trace deleted
|
||||
|
||||
* Src/extend.h:
|
||||
* Src/extend.c: Now, extended types are entered in the class
|
||||
hierarchy; When you define a new type, such as hash-table, a new
|
||||
class is defined. This class has a name which is built by adding
|
||||
brackets (<>) around the type name; this class always inherits from
|
||||
<object> (that means that it is not possible to make fancy
|
||||
inheritance schemes with the current solution, which would have been
|
||||
too difficult to take into account with dynamic loading precedence
|
||||
problems).
|
||||
|
||||
Sun Dec 15 11:04:10 1996 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/list.c: member: bug correction on circular lists
|
||||
* Src/list.c: New list functions: remq, remv, remove.
|
||||
|
||||
Sun Dec 8 10:13:30 1996 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STklos/Tk/Toplevel.stklos:
|
||||
* STklos/Tk/Tk-methods.stklos:
|
||||
* STklos/Tk/Tk-classes.stklos:
|
||||
* STklos/Tk/Basics.stklos: Bug correction: Toplevel.stklos could be
|
||||
sometimes loaded several times. Toplevel is now loaded when doing a
|
||||
(require "Tk-classes").
|
||||
|
||||
Thu Nov 14 22:17:58 1996 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Tk/generic/tkConfig.c (Tk_ConfigureInfo): Bug correction for gadgets
|
||||
with only 1 option (such as separator in menus)
|
||||
|
||||
* Demos/amib.stklos: Bug correction in code generation. It was
|
||||
possible to use a non yet defined widget in the ":in" option for
|
||||
"place" or "pack".
|
||||
|
||||
Sat Nov 9 15:17:06 1996 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STklos/Tk/Composite/Scrolltext.stklos:
|
||||
* STklos/Tk/Composite/Scrollcanvas.stklos:
|
||||
* STklos/Tk/Composite/Scrollbox.stklos: Scrollbars are now managed by
|
||||
grid.
|
||||
|
||||
Wed Nov 6 00:15:42 1996 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Tk4.2 integration.
|
||||
|
||||
Sun Nov 3 18:53:57 1996 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Lib/www-browser.stklos: A new Web browser package.
|
||||
|
||||
* Demos/webrowse.stklos: This demo replaces the hbrowse demo
|
||||
|
||||
|
||||
Wed Oct 30 16:19:46 1996 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Extensions/pixmap.c: upgrading pixmap package to the Tix 4.1b1
|
||||
|
||||
Tue Oct 29 00:54:05 1996 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Lib/www*.stk: New files for WEB browsing. Distant images and
|
||||
files are now correctly handled. A lot of ideas have been taken
|
||||
from the Harvey L. Stein WWW package.
|
||||
|
||||
Wed Oct 23 16:53:19 1996 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Demos/stklos-widgets.stklos: New demo which replaces compo-demo
|
||||
since it contains demo for widgets which are not composite.
|
||||
|
||||
* STklos/Tk/Widget/Balloon.stklos: new widget written in STklos
|
||||
|
||||
* Lib/focus.stk:
|
||||
* Lib/tk-init.stk: binding for <Tab> and <Shift-Tab> are now set in
|
||||
tk-init.stk to avoid problems when this default binding must be
|
||||
overloaded by user. Bug signalled by Harvey J. Stein
|
||||
<abel@netvision.net.il>
|
||||
|
||||
Mon Oct 21 12:29:07 1996 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STklos/active.stk: a new metaclass which provides actives slots.
|
||||
Actives slots are slots to which a function can be associated
|
||||
before/after reading/setting its value. The allocation is :active
|
||||
and functions can be set with :before-slot-ref, :after-slot-ref
|
||||
before-slot-set! or after-slot-set!.
|
||||
|
||||
* STklos/Tk/Widget/Gauge: Two new widgets written in Scheme:
|
||||
<Gauge> and <Valued-Gauge>. They use the active slots metaclass.
|
||||
|
||||
Thu Oct 17 14:50:29 1996 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Tk/generic/tkText.c: Modified "text dumping". It yields now a
|
||||
correct Scheme list. The :command option is not corrected correctly
|
||||
for now.
|
||||
|
||||
Mon Oct 14 10:22:37 1996 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Extensions/socket.c: Correction of a bug in socket_shutdown (when GC
|
||||
occurs)
|
||||
|
||||
Fri Oct 11 13:02:55 1996 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Extensions/socket.c (socket_shutdown): Bug correction in shutdown
|
||||
(shutdown and close where inverted).
|
||||
|
||||
* Src/number.c:
|
||||
* Src/read.c: Some change in number reading (in particular for
|
||||
string<->number conversions which were buggy when number start with
|
||||
a #.
|
||||
|
||||
Thu Oct 10 09:31:51 1996 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
|
||||
* configure.in:
|
||||
* Src/primitives.c: Adding support por JPEG images
|
||||
|
||||
Sun Oct 6 23:54:28 1996 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* Src/stk.h:
|
||||
* Src/char.c:
|
||||
* Src/port.c:
|
||||
* Src/sport.h:
|
||||
* Src/io.c:
|
||||
* Src/print.c: Scheme characters were used as unsigned char without
|
||||
explicitely specify it. Modified some declarations to specifically
|
||||
say that chars were unsigned.
|
||||
|
||||
Thu Sep 26 19:38:42 1996 Erick Gallesio <eg@unice.fr>
|
||||
|
||||
* STk-3.1.1 Release
|
||||
|
|
@ -1191,6 +1946,3 @@ Tue Aug 23 17:16:34 1994 Erick Gallesio (eg@kaolin.unice.fr)
|
|||
their enhancment (font, color, ...). Now, tags can be dynamically
|
||||
created (instead of choosen in a fixed list). A compatibility
|
||||
mode is provided (see above)
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -748,7 +748,7 @@
|
|||
;;; play.
|
||||
(set! quit-now #t)
|
||||
(after (* 2 fall-delay)
|
||||
'(begin
|
||||
(lambda()
|
||||
(reset-vars)
|
||||
(for-each destroy (find-items stetris-canvas 'all))
|
||||
(set! current-piece (make-new-stetris-piece))
|
||||
|
|
|
|||
|
|
@ -1 +0,0 @@
|
|||
../../Lib/trace.stk
|
||||
436
Demos/%README
436
Demos/%README
|
|
@ -1,278 +1,246 @@
|
|||
[Image] Demo directory
|
||||
|
||||
This directory contains demo programs for STk.
|
||||
|
||||
If you want to run a demo BEFORE a complete installation of the STk package,
|
||||
you must use the
|
||||
|
||||
../Src/test-stk
|
||||
|
||||
command to run the interpreter.
|
||||
|
||||
If you view this file with the STk HTML browser, you can click on each given
|
||||
command to launch a demo.
|
||||
Content
|
||||
|
||||
To use the STk HTML browser, just type:
|
||||
This directory contains the demo programs for STk. There are several
|
||||
categories of demos available from here:
|
||||
o STk demos: They correspond to program which don't use CLOS like
|
||||
object extension of STk. These demo are quite simple and they
|
||||
often mimic original Tcl/Tk demonstrations
|
||||
o STklos demos: These demonstration programs use the STklos object
|
||||
Extension of STk. The code of most of these demos has been kept
|
||||
short to illustrate the basic of STklos programming.
|
||||
o Html demo: This demo is in fact an overview of STk/STklos that I
|
||||
have used once in a presentation of STklos. The pages accessible
|
||||
from this link present STk but also contains links or Scheme
|
||||
applets which illustrate the kind of things that can be done with
|
||||
the STk browser. Of course, to properly execute the applets
|
||||
contained in theses pages, you need to run the STk Html browser
|
||||
(see below).
|
||||
|
||||
../Src/test-stk -f hbrowse README.html
|
||||
Running demonstration programs without installing STk
|
||||
|
||||
Happy STking
|
||||
----------------------------------------------------------------------------
|
||||
If you want to run a demo BEFORE a complete installation of the STk
|
||||
package, you must use the shell script ../Src/test-stk in order to run
|
||||
the interpreter (this shell script set some variables to run properly
|
||||
the interpreter without installing it).
|
||||
|
||||
STk demos
|
||||
Running demonstration programs in the STk web browser
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
STk provides a simple Web browser which can be used to launch the demo
|
||||
of this directory. If you are not running it now, you can type the
|
||||
following command:
|
||||
|
||||
File
|
||||
browse.stk
|
||||
Description
|
||||
a simple Unix file browser
|
||||
Run
|
||||
../Src/test-stk -f browse.stk
|
||||
../Src/test-stk -f S-scape README.html
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
at the shell prompt.
|
||||
|
||||
File
|
||||
colormap.stk
|
||||
Description
|
||||
a simple color builder
|
||||
Run
|
||||
../Src/test-stk -f colormap.stk
|
||||
Comment
|
||||
On exit, the RGB value is printed on the sandard output
|
||||
1. STk demos
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
1.1 Basic STk demos
|
||||
|
||||
File
|
||||
small-ed.stk
|
||||
Description
|
||||
A small editor to create enhanced text
|
||||
Run
|
||||
../Src/test-stk -f small-ed.stk
|
||||
Comment
|
||||
Does not work (still) with STk 3.0
|
||||
* hello.stk
|
||||
This is the traditional first program. This program creates a single
|
||||
button that you can click on.
|
||||
Run with : ../Src/test-stk -f hello.stk
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
* browse.stk
|
||||
A simple Unix file browser. The code of this demo is less than a page.
|
||||
Run with: .../Src/test-stk -f browse.stk
|
||||
|
||||
File
|
||||
hanoi.stk
|
||||
Description
|
||||
Hanoi towers animation
|
||||
Run
|
||||
../Src/test-stk -f hanoi.stk
|
||||
1.2 Basics of STk programming
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
File
|
||||
hello.stk
|
||||
Description
|
||||
a simple button demonstration
|
||||
Run
|
||||
../Src/test-stk -f hello.stk
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
File
|
||||
showvars.stk
|
||||
Description
|
||||
a variable shower
|
||||
This program shows the value of three variables (named a,b and c)
|
||||
Changing the value of one of these vars (with a set! for instance) will
|
||||
redisplay its new value immediatly
|
||||
Run
|
||||
../Src/test-stk -load showvars.stk
|
||||
Comment
|
||||
Exit
|
||||
type (exit) on the STk prompt
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
File
|
||||
turtle.stk
|
||||
Description
|
||||
a Logo turtle package + some demo functions.
|
||||
Run
|
||||
../Src/test-stk -f turtle.stk
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
File
|
||||
inspector.stk
|
||||
Description
|
||||
A simple demo of the inspector on Tk widgets
|
||||
Run
|
||||
../Src/test-stk -f inspector.stk
|
||||
Comment
|
||||
Does not work (still) with STk 3.0
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
File
|
||||
mc-server.stk
|
||||
Description
|
||||
A multiple-clients server.
|
||||
Run
|
||||
../Src/test-stk -load mc-server.stk
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
File
|
||||
queens.stk
|
||||
Description
|
||||
The queens problem. You can do it yourself (and it will make sure you
|
||||
follow the rules) or you can ask it to solve the puzzle starting with a
|
||||
given board configuration. This code is a contribution of Grant Edwards
|
||||
(grante@rosemount.com)
|
||||
Run
|
||||
../Src/test-stk -f queens.stk
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
File
|
||||
stetris.stk
|
||||
Description
|
||||
This is a falling block game not unlike tetris(tm) :). It is
|
||||
implemented in STk just to prove it can be done, and as a challenge to
|
||||
TCLers. It starts slowly and becomes faster and faster. Have fun. This
|
||||
code is a contribution of Harvey J. Stein(hjstein@math.huji.ac.il)
|
||||
Run
|
||||
../Src/test-stk -f stetris.stk
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
File
|
||||
ttt.stk
|
||||
Description
|
||||
A 3D Tic-Tac-Toe, where the board is 4x4x4, a 3 dimensional board of
|
||||
four planes with four rows and four columns each. This code is a
|
||||
contribution of Edin "Dino" Hodzic <ehodzic@scu.edu>
|
||||
Run
|
||||
../Src/test-stk -f ttt.stk
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
File
|
||||
server.stk
|
||||
Description
|
||||
A simple server showing how to use the socket package. It creates a
|
||||
xterm window in which a read-eval-print-loop is executed. When the
|
||||
window is closed or when an error occurs, the socket is closed
|
||||
Run
|
||||
../Src/test-stk -f server.stk
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
File
|
||||
term.stk
|
||||
Description
|
||||
A simple terminal emulator (a kind of xterm, but in a text widget).
|
||||
Run
|
||||
../Src/test-stk -f term.stk
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
|
||||
File
|
||||
wtour.stk
|
||||
Description
|
||||
* wtour.stk
|
||||
This is a rewrite of the Tcl/Tk wtour2.0 in Scheme/STk. Use the menus
|
||||
to navigate through different lessons. You can make changes to the
|
||||
lesson source code; click on the Apply button to see the results of the
|
||||
changes.
|
||||
Run
|
||||
../Src/test-stk -f ./wtour.stk ../Contrib/STk-wtour
|
||||
Run with: ../Src/test-stk -f ./wtour.stk ../Contrib/STk-wtour
|
||||
Comment: This code is a contribution of Suresh Srinivas
|
||||
<ssriniva@cs.indiana.edu>
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
1.3 Client/Server Demos
|
||||
|
||||
STklos demos
|
||||
* server.stk
|
||||
A simple server showing how to use the socket package. It creates an
|
||||
xterm window in which a read-eval-print-loop is executed. When the
|
||||
window is closed or when an error occurs, the socket is closed
|
||||
Run with: ../Src/test-stk -no -f server.stk
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
There are few demos of STklos. What is interesting is not what they do but
|
||||
how they are programmmed (IMO).
|
||||
----------------------------------------------------------------------------
|
||||
* mc-server.stk
|
||||
A multiple-clients server. On Unix, you can use several telnet sessions
|
||||
to discuss with the server. Each discussion has its own dedicated
|
||||
channel. Type (exit) at the STk when you want to exit the demo.
|
||||
Run with: ../Src/test-stk -load mc-server.stk
|
||||
|
||||
File
|
||||
widget.stklos
|
||||
Description
|
||||
A tour of the Tk widgets. This demo shows all the Tk widgets
|
||||
Run
|
||||
../Src/test-stk -f widget.stklos
|
||||
1.4 Fun and Games
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
* turtle.stk
|
||||
A Logo turtle package + some demo functions.
|
||||
Run with: ../Src/test-stk -f turtle.stk
|
||||
|
||||
File
|
||||
stklos-demo.stklos
|
||||
Description
|
||||
a simple demo written in STklos
|
||||
Run
|
||||
../Src/test-stk -f stklos-demo.stklos
|
||||
* hanoi.stk
|
||||
Hanoi towers animation.
|
||||
Run with: ../Src/test-stk -f hanoi.stk
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
* queens.stk
|
||||
The queens problem. You can do it yourself (and it will make sure you
|
||||
follow the rules) or you can ask it to solve the puzzle starting with a
|
||||
given board configuration.
|
||||
Run with: ../Src/test-stk -f queens.stk
|
||||
Comment: This code is a contribution of Grant Edwards
|
||||
<grante@rosemount.com)>
|
||||
|
||||
File
|
||||
stklos-demo2.stklos
|
||||
Description
|
||||
another simple demo written in STklos
|
||||
Run
|
||||
../Src/test-stk -f stklos-demo2.stklos
|
||||
* stetris.stk
|
||||
This is a falling block game not unlike tetris(tm) :). It is
|
||||
implemented in STk just to prove it can be done, and as a challenge to
|
||||
TCLers. It starts slowly and becomes faster and faster. Have fun.
|
||||
Run with: ../Src/test-stk -f stetris.stk
|
||||
Comment: This code is a contribution of Harvey J. Stein
|
||||
<hjstein@math.huji.ac.il>
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
* ttt.stk
|
||||
A 3D Tic-Tac-Toe, where the board is 4x4x4, a 3 dimensional board of
|
||||
four planes with four rows and four columns each.
|
||||
Run with: ../Src/test-stk -f ttt.stk
|
||||
Comment: This code is a contribution of Edin "Dino" Hodzic
|
||||
<ehodzic@scu.edu>
|
||||
|
||||
File
|
||||
hello.stklos
|
||||
Description
|
||||
a rewriting of the hello.stk demo in STklos
|
||||
Run
|
||||
../Src/test-stk -f hello.stklos
|
||||
1.5 Misc
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
* colormap.stk
|
||||
This is a simple color palette written in STk.
|
||||
Run with: ../Src/test-stk -f colormap.stk
|
||||
Comment: Note that this program is no more really useful since STk
|
||||
offers now the function Tk:choose-color which allow to choose a color
|
||||
by name or by value.
|
||||
|
||||
File
|
||||
browse.stklos
|
||||
Description
|
||||
a rewriting of the browse.stk demo in STklos
|
||||
Run
|
||||
../Src/test-stk -f browse.stklos
|
||||
* small-ed.stk
|
||||
A small editor to create enhanced text
|
||||
Run with: ../Src/test-stk -f small-ed.stk
|
||||
Comment: This editor use a ad-hoc format for saving file and was used
|
||||
for the help buttons of various widgets in old versions of STk. It will
|
||||
not be developed anymore since the preferred format for help is now
|
||||
HTML.
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
* showvars.stk
|
||||
A variable shower: this program shows the value of three variables
|
||||
(named a,b and c) Changing the value of one of these vars (with a set!
|
||||
for instance) will redisplay its new value immediately. Run with:
|
||||
../Src/test-stk -load showvars.stk
|
||||
|
||||
File
|
||||
calc.stklos
|
||||
Description
|
||||
a very simple calculator
|
||||
Run
|
||||
../Src/test-stk -f calc.stklos
|
||||
* inspector.stk
|
||||
A simple demo of the inspector on Tk widgets
|
||||
Run with: ../Src/test-stk -f inspector.stk
|
||||
Comment: Does not work with this version of STk
|
||||
A new version of the inspector is in practically finished and will be
|
||||
soon released.
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
* term.stk
|
||||
A simple terminal emulator (a kind of xterm, but in a text widget).
|
||||
Run with: ../Src/test-stk -f term.stk
|
||||
Comment: Users of Glibc2 (aka libc6, or RedHat 5.0 users): This program
|
||||
has problems with new release of the libc under Linux, if your shell
|
||||
has the line editing mode set. To avoid the problem you can
|
||||
o disable the line editing mode of your shell
|
||||
o set the SHELL variable to a dumb shell (e.g. ash)
|
||||
o link STk with the old libc
|
||||
o don't run the demo :-)
|
||||
|
||||
File
|
||||
compo-demo.stklos
|
||||
Description
|
||||
A quick demo of the composite widgets which are in the STk release.
|
||||
This code is a contribution of <Drew.Whitehouse@anu.edu.au>
|
||||
Run
|
||||
../Src/test-stk -f compo-demo.stklos
|
||||
2. STklos demos
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
All the standard Tk widgets have been wrapped in STklos classes. As a
|
||||
result, in STklos, Tk widgets are seen as instances of STklos classes.
|
||||
There are two kinds of STklos widgets:
|
||||
o Simple widgets which map one to one the Tk standard widgets
|
||||
o Composite widgets which are built from simple Tk widgets (or even
|
||||
simpler composite widgets).
|
||||
Demonstration programs accessible from this page use indifferently
|
||||
simple widgets and composite widgets.
|
||||
|
||||
File
|
||||
filebox.stklos
|
||||
Description
|
||||
a simple program which uses the <File-box> compositeclass. A <File-box>
|
||||
is a file requestor with file name completion. It is a composition of
|
||||
various composite widget classes.
|
||||
Run
|
||||
../Src/test-stk -f filebox.stklos
|
||||
2.1 Basic STklos demos
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
* hello.stklos
|
||||
This is a simple rewriting of the hello.stk demonstration in STklos
|
||||
Run with: ../Src/test-stk -f hello.stklos
|
||||
|
||||
File
|
||||
tkcolor.stklos
|
||||
Description
|
||||
a simple color picker written in STklos. Clicking button 1 on the color
|
||||
box sets the text color to that color; Clicking button 3 sets the
|
||||
background.
|
||||
Run
|
||||
../Src/test-stk -f tkcolor.stklos
|
||||
* browse.stklos
|
||||
This is a simple rewriting of the browse.stk demonstration in STklos
|
||||
Run with: ../Src/test-stk -f browse.stklos
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
eg@unice.fr
|
||||
* stklos-demo.stklos A simple demo written in STklos.
|
||||
Run with: ../Src/test-stk -f stklos-demo.stklos
|
||||
Comment: What is interesting in this demo is not what it does, nothing
|
||||
specially fancy, but how it is easy to program, IMHO.
|
||||
|
||||
* stklos-demo2.stklos Another simple demo written in STklos.
|
||||
Run with: ../Src/test-stk -f stklos-demo2.stklos
|
||||
Comment: Here again, what is interesting in this demo is not what it
|
||||
does, nothing specially fancy, but how it is easy to program, IMHO.
|
||||
|
||||
2.2 STklos widgets
|
||||
|
||||
* widget.stklos
|
||||
A tour of the Tk widgets. This demo shows all the Tk widgets. This is a
|
||||
rewriting in STklos of the big Tcl/Tk demo widget.tcl. For each widget
|
||||
demo accessible from this program, you can see the source by just
|
||||
clicking the "See code" button. You can modify the code and test your
|
||||
modified version by clicking the button "Rerun demo"
|
||||
Run with: ../Src/test-stk -f widget.stk
|
||||
Comment: This demo illustrate only the simple widgets (the ones of the
|
||||
Tk library). For a composite widgets demo look at the
|
||||
stklos-widgets.stklos program.
|
||||
|
||||
* filebox.stklos
|
||||
This is a simple program which uses the <File-box> composite widget. A
|
||||
<File-box> is a file requester with file name completion (on the Tab
|
||||
key).This widget is itself a composition of various composite widget
|
||||
classes.
|
||||
Run with: ../Src/test-stk -f filebox.stklos
|
||||
|
||||
* stklos-widgets.stklos
|
||||
A quick demo of some of the STklos Composite widgets which are
|
||||
available in this release.
|
||||
Run with: ../Src/test-stk -f stklos-widgets.stklos
|
||||
Comment: This code is a contribution of Drew Whitehouse
|
||||
<Drew.Whitehouse@anu.edu.au>.
|
||||
|
||||
2.3 STklos Applications
|
||||
|
||||
* calc.stklos
|
||||
This is a simplistic calculator.
|
||||
Run with: ../Src/test-stk -f calc.stklos
|
||||
|
||||
* tkcolor.stklos
|
||||
This is a simple color picker written in STklos. Clicking the left
|
||||
mouse button in the color box sets the text color to the chosen color.
|
||||
Clicking the right button sets the background color. The Select button
|
||||
sets the selection to a string which can be used (by pasting it in an
|
||||
xterm window) as argument of most X11 applications to set their
|
||||
foreground and background color.
|
||||
Run with: ../Src/test-stk -f tkcolor.stklos
|
||||
|
||||
* amib.stklos
|
||||
A Mini Interface Builder.
|
||||
Run with: ../Src/test-stk -f amib.stklos
|
||||
Comment: The current version of AMIB allow you to:
|
||||
o place objects on a plane by drag and drop
|
||||
o resize objects
|
||||
o displace objects
|
||||
o change all the slots of an object (color, font, value, ...)
|
||||
o save an interface to reload it later in an application
|
||||
However it is far from a really usable interface builder (but after all
|
||||
it is only a 600 lines of code application!!!!)
|
||||
|
||||
* S-scape.stklos
|
||||
The STk web browser. You are probably using it while seeing these
|
||||
lines.
|
||||
Run with: ../Src/test-stk -f S-scape.stklos
|
||||
|
||||
------------------------------------------------------------------------
|
||||
Erick Gallesio
|
||||
Last modified: Mon Mar 9 19:15:46 CET 1998
|
||||
|
|
|
|||
|
|
@ -0,0 +1,11 @@
|
|||
|
||||
prog/movies/mosaic Animated Mosaic Icon (for ctwm)
|
||||
|
||||
The icon in this directory was extracted from the Mosaic WWW distribution
|
||||
and donated by Vivek Khera <khera@norval.clark.net>.
|
||||
|
||||
Author Unknown.
|
||||
|
||||
Note These icons have been NOT been recolored to the standard color table.
|
||||
|
||||
Anthony Thyssen <anthony@cit.gu.edu.au> http://www.cit.gu.edu.au/~anthony/
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 1.2 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 38 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 89 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 714 B |
Binary file not shown.
|
After Width: | Height: | Size: 1.8 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 3.4 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 1.0 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 8.0 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 2.0 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 1.5 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 939 B |
Binary file not shown.
|
After Width: | Height: | Size: 717 B |
Binary file not shown.
|
After Width: | Height: | Size: 722 B |
Binary file not shown.
|
After Width: | Height: | Size: 726 B |
Binary file not shown.
|
After Width: | Height: | Size: 824 B |
Binary file not shown.
|
After Width: | Height: | Size: 701 B |
Binary file not shown.
|
After Width: | Height: | Size: 799 B |
Binary file not shown.
|
After Width: | Height: | Size: 848 B |
Binary file not shown.
|
After Width: | Height: | Size: 847 B |
Binary file not shown.
|
After Width: | Height: | Size: 752 B |
Binary file not shown.
|
After Width: | Height: | Size: 883 B |
Binary file not shown.
|
After Width: | Height: | Size: 893 B |
Binary file not shown.
|
After Width: | Height: | Size: 887 B |
Binary file not shown.
|
After Width: | Height: | Size: 892 B |
Binary file not shown.
|
After Width: | Height: | Size: 877 B |
Binary file not shown.
|
After Width: | Height: | Size: 882 B |
Binary file not shown.
|
After Width: | Height: | Size: 869 B |
Binary file not shown.
|
After Width: | Height: | Size: 850 B |
Binary file not shown.
|
After Width: | Height: | Size: 822 B |
Binary file not shown.
|
After Width: | Height: | Size: 817 B |
Binary file not shown.
|
After Width: | Height: | Size: 844 B |
Binary file not shown.
|
After Width: | Height: | Size: 837 B |
Binary file not shown.
|
After Width: | Height: | Size: 830 B |
Binary file not shown.
|
After Width: | Height: | Size: 733 B |
Binary file not shown.
|
After Width: | Height: | Size: 731 B |
Binary file not shown.
|
After Width: | Height: | Size: 732 B |
|
|
@ -0,0 +1,65 @@
|
|||
;;
|
||||
;; Resources
|
||||
;;
|
||||
(option 'add "*LabeledEntry.Entry.Background" "white" "widgetDefault")
|
||||
(option 'add "*LabeledEntry.Entry.Font" "fixed" "widgetDefault")
|
||||
(option 'add "*LabeledEntry.Entry.Relief" "sunken" "widgetDefault")
|
||||
|
||||
;;
|
||||
;; Class definition
|
||||
;;
|
||||
(define-class <Labeled-entry> (<Tk-composite-widget> <Entry>)
|
||||
((entry :accessor entry-of)
|
||||
(label :accessor label-of)
|
||||
(class :init-keyword :class
|
||||
:init-form "LabeledEntry")
|
||||
|
||||
;; Fictive slots
|
||||
(title :accessor title
|
||||
:init-keyword :title
|
||||
:allocation :propagated
|
||||
:propagate-to ((label text)))
|
||||
(title-width :accessor title-width
|
||||
:init-keyword :title-width
|
||||
:allocation :propagated
|
||||
:propagate-to ((label width)))
|
||||
(title-anchor :accessor title-anchor
|
||||
:init-keyword :title-anchor
|
||||
:allocation :propagated
|
||||
:propagate-to ((label anchor)))
|
||||
(anchor :accessor anchor
|
||||
:init-keyword :anchor
|
||||
:allocation :propagated
|
||||
:propagate-to (label))
|
||||
(background :accessor background
|
||||
:init-keyword :background
|
||||
:allocation :propagated
|
||||
:propagate-to (frame entry label))
|
||||
(foreground :accessor foreground
|
||||
:init-keyword :foreground
|
||||
:allocation :propagated
|
||||
:propagate-to (entry label))
|
||||
(border-width :accessor border-width
|
||||
:allocation :propagated
|
||||
:init-keyword :border-width
|
||||
:propagate-to (frame))
|
||||
(relief :accessor relief
|
||||
:init-keyword :relief
|
||||
:allocation :propagated
|
||||
:propagate-to (frame))
|
||||
(entry-relief :accessor entry-relief
|
||||
:init-keyword :entry-relief
|
||||
:allocation :propagated
|
||||
:propagate-to ((entry relief))) ))
|
||||
|
||||
(define-method initialize-composite-widget ((self <Labeled-entry>) initargs frame)
|
||||
(let* ((e (make <Entry> :parent frame))
|
||||
(l (make <Label> :parent frame)))
|
||||
(next-method)
|
||||
(pack (Id l) :side "left" :padx 2 :pady 2)
|
||||
(pack e :side "right" :padx 2 :pady 2 :expand #t :fill "x")
|
||||
|
||||
(slot-set! self 'Id (slot-ref e 'Id))
|
||||
(slot-set! self 'entry e)
|
||||
(slot-set! self 'label l)))
|
||||
|
||||
|
|
@ -0,0 +1,34 @@
|
|||
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
|
||||
<html>
|
||||
<head>
|
||||
<title>S-scape: le browser Web de STk.</title>
|
||||
</head>
|
||||
|
||||
<body bgcolor=white>
|
||||
<h1><img src="Images/STk-tiny.gif"><i>S-scape</i>: le browser Web de STk.</h1>
|
||||
<font size=+4>
|
||||
<b>S-scape</b> est un browser Web<P>
|
||||
<ul>
|
||||
<li> Ecrit entièrement en Scheme;<P>
|
||||
<li> Reconnait un sous-ensemble de la norme HTML 2.0 (pas de <i>"forms"</i>)<P>
|
||||
<li> Sert principalement pour accéder à l'aide en ligne:<p>
|
||||
<ul>
|
||||
<li><tt> <A expr=(help)> (help) </A></tt><p>
|
||||
<li><tt> <A expr=(help "bell")>(help "bell")</A></tt>
|
||||
</ul><p>
|
||||
<li> Permet de définir des <i>"<A HREF="applet-fr.html">applets</A>"</i>
|
||||
en Scheme<P>
|
||||
<li> Permet la consultation de pages <b>distantes</b> (<i>e.g.</i>
|
||||
<A HREF=http://kaolin.unice.fr/>http://kaolin.unice.fr/</A>)
|
||||
</ul>
|
||||
</font>
|
||||
<hr>
|
||||
<A HREF="main-fr.html"><img src="Images/backward.gif" align=middle> Retour</A>
|
||||
<hr>
|
||||
<address><a href="mailto:eg@unice.fr">Erick Gallesio</a></address>
|
||||
<!-- Created: Mon Mar 9 13:00:15 CET 1998 -->
|
||||
<!-- hhmts start -->
|
||||
Last modified: Mon Mar 9 21:41:18 CET 1998
|
||||
<!-- hhmts end -->
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,63 @@
|
|||
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
|
||||
<html>
|
||||
<head>
|
||||
<title>Construction d'interfaces en STklos</title>
|
||||
</head>
|
||||
|
||||
<body bgcolor=white>
|
||||
<script language="STk">
|
||||
(lambda (parent url)
|
||||
(let ((dir (dirname (expand-file-name
|
||||
((with-module URL url:filename) url)))))
|
||||
(chdir dir)))
|
||||
</script>
|
||||
|
||||
|
||||
|
||||
<h1><img src="Images/STk-tiny.gif">
|
||||
AMIB: <font color=red>A</font>
|
||||
<font color=red>M</font>ini
|
||||
<font color=red>I</font>nterface
|
||||
<font color=red>B</font>uilder</h1>
|
||||
<font size=+4>
|
||||
<center>
|
||||
<a href="Images/amib.gif"><img src="Images/amib-tiny.gif"></a>
|
||||
</center>
|
||||
<ul>
|
||||
</ul><p>
|
||||
<I>Objectif</I>: Construction interactive d'interfaces graphiques<P>
|
||||
<ul>
|
||||
<li> Ecrit en STklos<P>
|
||||
<li> Permet
|
||||
<ul>
|
||||
<li> Construction interactive d'interfaces graphiques;
|
||||
<li> Sauvegarde/Chargement des interfaces construites<P>
|
||||
</ul>
|
||||
<li> Utilise le MOP de STklos<P>
|
||||
<li> Code
|
||||
<ul>
|
||||
<li> générique (ajouter une nouvelle widget
|
||||
<==> ajouter une ligne dans le programme
|
||||
<li> juste une démo (moins de <B>600 lignes!!</B>)<p>
|
||||
</ul>
|
||||
|
||||
<li> Lancer une démo d'AMIB avec
|
||||
<ul>
|
||||
<li> la version non installée de STk
|
||||
(<a expr=(system "test-stk -f amib.stklos&")><tt>test-stk -f amib.stklos&</tt></a>)
|
||||
<li> la version installée de STk
|
||||
(<a expr=(system "stk -f amib.stklos &")><tt>stk -f amib.stklos&</tt></a>)
|
||||
</ul>
|
||||
</ul>
|
||||
</font>
|
||||
</font>
|
||||
<hr>
|
||||
<A HREF="main-fr.html"><img src="Images/backward.gif" align=middle> Retour</A>
|
||||
<hr>
|
||||
<address><a href="mailto:eg@unice.fr">Erick Gallesio</a></address>
|
||||
<!-- Created: Tue Mar 10 17:40:16 CET 1998 -->
|
||||
<!-- hhmts start -->
|
||||
Last modified: Tue Mar 10 18:41:48 CET 1998
|
||||
<!-- hhmts end -->
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1 @@
|
|||
../amib.stklos
|
||||
|
|
@ -0,0 +1,56 @@
|
|||
;;;; animate.stk -- A simple image animation (Demo)
|
||||
;;;;
|
||||
;;;; Copyright © 1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
;;;;
|
||||
;;;; Permission to use, copy, and/or distribute this software and its
|
||||
;;;; documentation for any purpose and without fee is hereby granted, provided
|
||||
;;;; that both the above copyright notice and this permission notice appear in
|
||||
;;;; all copies and derived works. Fees for distribution or use of this
|
||||
;;;; software or derived works may only be charged with express written
|
||||
;;;; permission of the copyright holder.
|
||||
;;;; This software is provided ``as is'' without express or implied warranty.
|
||||
;;;;
|
||||
;;;; $Id: animate.stk 1.1 Tue, 10 Mar 1998 21:43:37 +0100 eg $
|
||||
;;;;
|
||||
;;;; Author: Erick Gallesio [eg@unice.fr]
|
||||
;;;; Creation date: 9-Mar-1998 18:51
|
||||
;;;;Last file update: 9-Mar-1998 21:07
|
||||
|
||||
(define *img* #f)
|
||||
|
||||
(define (make-animation pattern parent delay)
|
||||
(let* ((files (sort (glob pattern) string<?))
|
||||
(size (length files))
|
||||
(images (make-vector size))
|
||||
(name (gensym (& (if (eq? parent *root*) "" parent) ".l")))
|
||||
(widget (label name :bd 0 :relief "flat" :background "white"
|
||||
:env (the-environment))))
|
||||
;; Store in the image vector all the components of the animation
|
||||
(dotimes (i size)
|
||||
(let ((key (list-ref files i)))
|
||||
(vector-set! images
|
||||
i
|
||||
(make-image key :file key))))
|
||||
|
||||
;; Display the first image of the animation
|
||||
(tk-set! widget :image (vector-ref images 0))
|
||||
|
||||
;; Animate the image
|
||||
(letrec ((anim (let ((i 0))
|
||||
(lambda ()
|
||||
(if (>= delay 0)
|
||||
(when (winfo (quote exists) widget)
|
||||
(if (>= i size) (set! i 0))
|
||||
(tk-set! widget :image (vector-ref images i))
|
||||
(set! i (+ i 1))
|
||||
(update)
|
||||
(after (abs delay) anim))
|
||||
(after 100 anim))))))
|
||||
(after 'idle anim))
|
||||
widget))
|
||||
|
||||
|
||||
(define (change-animation-delay w delay)
|
||||
(let ((env (tk-get w :env)))
|
||||
(eval `(set! delay ,delay) env)))
|
||||
|
||||
|
|
@ -0,0 +1,70 @@
|
|||
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
|
||||
<html>
|
||||
<head>
|
||||
<title>Applets en STk</title>
|
||||
</head>
|
||||
|
||||
<body bgcolor=white>
|
||||
<h1><img src="Images/STk-tiny.gif">Applets en STk</h1>
|
||||
<p>
|
||||
|
||||
<script language="STk">
|
||||
(lambda (parent url)
|
||||
(let ((dir (dirname (expand-file-name
|
||||
((with-module URL url:filename) url)))))
|
||||
(load (string-append dir "/animate.stk"))))
|
||||
</script>
|
||||
|
||||
<font size=+4>
|
||||
<b>S-scape</b> permet d'insérer du code STk dans une page HTML.
|
||||
<P> Exemples d'utilisation:
|
||||
<ul>
|
||||
<li> Animation:
|
||||
<script language="STk">
|
||||
(lambda (parent url)
|
||||
(let* ((dir (dirname (expand-file-name
|
||||
((with-module URL url:filename) url))))
|
||||
(img (make-animation (string-append dir "/Images/mosaic*")
|
||||
parent 100)))
|
||||
(set! *img* img)
|
||||
(pack img :expand #t :fill "both")))
|
||||
</script>
|
||||
<p>
|
||||
<li> Morceau d'interface embarqué:
|
||||
<script language="STk">
|
||||
(lambda (parent url)
|
||||
(let ((w (scale (format #f "~A.scale" (widget-name parent))
|
||||
:label "delay between frames (ms)" :orient "hor"
|
||||
:to 300 :length 250))
|
||||
(b (button (format #f "~A.butt" (widget-name parent))
|
||||
:text "Stop animation" :foreground "red")))
|
||||
(w 'set 100)
|
||||
(tk-set! w :command (lambda (x)
|
||||
(change-animation-delay *img* (w 'get))))
|
||||
(tk-set! b :command (lambda ()
|
||||
(change-animation-delay *img* -1)))
|
||||
(pack w b :expand #t :fill "both")))
|
||||
</script>
|
||||
<p>
|
||||
<li> Application embarquée:
|
||||
<script language="STk">
|
||||
(lambda (parent url)
|
||||
(let ((dir (dirname (expand-file-name
|
||||
((with-module URL url:filename) url)))))
|
||||
(load (string-append dir "/puzzle.stk"))
|
||||
(display-puzzle parent)))
|
||||
|
||||
</script>
|
||||
</ul>
|
||||
|
||||
</font>
|
||||
<hr>
|
||||
<A HREF="main-fr.html"><img src="Images/backward.gif" align=middle> Retour</A>
|
||||
<hr>
|
||||
<address><a href="mailto:eg@unice.fr">Erick Gallesio</a></address>
|
||||
<!-- Created: Mon Mar 9 13:16:50 CET 1998 -->
|
||||
<!-- hhmts start -->
|
||||
Last modified: Tue Mar 10 21:37:14 CET 1998
|
||||
<!-- hhmts end -->
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,70 @@
|
|||
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
|
||||
<html>
|
||||
<head>
|
||||
<title>Widgets composites</title>
|
||||
</head>
|
||||
|
||||
<body bgcolor="white">
|
||||
<script language="STk">
|
||||
(lambda (parent url)
|
||||
(let ((dir (dirname (expand-file-name
|
||||
((with-module URL url:filename) url)))))
|
||||
(chdir dir)))
|
||||
</script>
|
||||
|
||||
|
||||
<h1><img src="Images/STk-tiny.gif">Widgets composites</h1>
|
||||
<font size=+4>
|
||||
Une widget composite consiste en fait en un assemblage de plusieurs
|
||||
widgets (simples ou composites):
|
||||
</font>
|
||||
|
||||
<pre>
|
||||
(define le (make <Labeled-entry> :value 50 :title "Valeur:"))
|
||||
</pre>
|
||||
|
||||
<font size=+4>
|
||||
permet de définir <tt>le</tt> comme une instance de la classe
|
||||
<tt><Labeled-entry></tt>. L'affichage de cet objet est donné
|
||||
ci-dessous:
|
||||
<p>
|
||||
<center>
|
||||
<IMG SRC="Images/compo-all.gif"><P>
|
||||
</center>
|
||||
<pre>
|
||||
|
||||
|
||||
</pre>
|
||||
En fait, cette image est composée de trois widgets Tk de base: une
|
||||
<i>frame</i>, un <i>label</i> et une <i>entry</i>:
|
||||
<pre>
|
||||
|
||||
</pre>
|
||||
<center>
|
||||
<IMG SRC=Images/frame.gif> + <IMG SRC=Images/label.gif> + <IMG SRC=Images/entry.gif><P>
|
||||
</center>
|
||||
|
||||
<pre>
|
||||
|
||||
</pre>
|
||||
<ul>
|
||||
<li> Une démonstration de quelques widgets composites peut-être exécutée d'ici
|
||||
<ul>
|
||||
<li> la version non installée de STk
|
||||
(<a expr=(system "test-stk -f stklos-widgets.stklos&")><tt>test-stk</tt></a>)
|
||||
<li> la version installée de STk
|
||||
(<a expr=(system "stk -f stklos-widgets.stklos &")><tt>stk</tt></a>)<p>
|
||||
</ul>
|
||||
<li> Le <a href="Lentry.stklos">code</a> complet de la classe <tt><Labeled-entry></tt> fait environ 60 lignes.
|
||||
</ul>
|
||||
</font>
|
||||
<hr>
|
||||
<A HREF="main-fr.html"><img src="Images/backward.gif" align=middle> Retour</A>
|
||||
<hr>
|
||||
<address><a href="mailto:eg@unice.fr">Erick Gallesio</a></address>
|
||||
<!-- Created: Tue Mar 10 18:42:29 CET 1998 -->
|
||||
<!-- hhmts start -->
|
||||
Last modified: Tue Mar 10 19:26:41 CET 1998
|
||||
<!-- hhmts end -->
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,33 @@
|
|||
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
|
||||
<html>
|
||||
<head>
|
||||
<title>Envdraw</title>
|
||||
</head>
|
||||
|
||||
<body>
|
||||
<h1>Envdraw</h1>
|
||||
|
||||
|
||||
EnvDraw is a environment diagramming package which draws environment
|
||||
diagrams as taught in Abelson and Sussman's _Structure and
|
||||
Interpretation of Computer Languages_. It was written as an
|
||||
instructional tool for the CS61A course at the University of
|
||||
California at Berkeley. The environment diagrammer is a metacircular
|
||||
evaluator which draws procedures, environments, and box and pointer
|
||||
diagrams along with all the accompanying symbols and mutation. It
|
||||
includes a box and pointer diagrammer which handles circular list
|
||||
structures, cons cell mutation, and also will watch for modification
|
||||
of any symbols known to be pointing to drawn cells.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
<hr>
|
||||
<address><a href="mailto:eg@unice.fr">Erick Gallesio</a></address>
|
||||
<!-- Created: Tue Mar 10 19:29:32 CET 1998 -->
|
||||
<!-- hhmts start -->
|
||||
<!-- hhmts end -->
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,47 @@
|
|||
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
|
||||
<html>
|
||||
<head>
|
||||
<title>Envdraw</title>
|
||||
</head>
|
||||
|
||||
<body bgcolor=white>
|
||||
<h1><img src="Images/STk-tiny.gif"> Envdraw</h1>
|
||||
<font size=+4>
|
||||
<center>
|
||||
<img src="Images/envdraw.gif">
|
||||
</center>
|
||||
<pre>
|
||||
|
||||
</pre>
|
||||
|
||||
|
||||
|
||||
EnvDraw est un package qui permet de dessiner les diagrammes
|
||||
d'environnement tels qu'il sont présentés dans le livre
|
||||
<b>Structure and Interpretation of Computer Languages</b>
|
||||
<i>d'Abelson et Sussman</i>.
|
||||
|
||||
<p>
|
||||
Cet outil a été écrit comme un outil pédagogique pour le cours
|
||||
<b>CS61A</b> de l'Université de Berkeley (Californie).
|
||||
|
||||
Envdraw est en fait un interprète méta-circulaire capable de
|
||||
dessiner des procedures, des environnement ainsi que des listes sous forme
|
||||
de boîtes (les listes circulaire sont gérées)
|
||||
Les symbole permettant d'accéder à ces objets ainsi que les
|
||||
modifications apportées aux objets sont répercutées sur le diagramme.
|
||||
|
||||
<p>
|
||||
Envdraw peut être récupéré à l'URL suivante:
|
||||
<a href=http://kaolin.unice.fr/Contribs">http://kaolin.unice.fr/Contribs</a>
|
||||
</font>
|
||||
<hr>
|
||||
<A HREF="main-fr.html"><img src="Images/backward.gif" align=middle> Retour</A>
|
||||
<hr>
|
||||
<address><a href="mailto:eg@unice.fr">Erick Gallesio</a></address>
|
||||
<!-- Created: Tue Mar 10 19:29:32 CET 1998 -->
|
||||
<!-- hhmts start -->
|
||||
Last modified: Tue Mar 10 21:24:50 CET 1998
|
||||
<!-- hhmts end -->
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,49 @@
|
|||
;; C'est très laid. puisque ca peremt de définir une globale et donc de
|
||||
;; truander les controles d'accès.
|
||||
;; (scale '.s :variable 'speed)
|
||||
;; (.s 'set 1)
|
||||
;; (destroy .s)
|
||||
|
||||
(require "image")
|
||||
|
||||
(define (make-animation pattern parent delay)
|
||||
(let* ((files (sort (glob pattern) string<?))
|
||||
(size (length files))
|
||||
(images (make-vector size))
|
||||
(name (gensym (& (if (eq? parent *root*) "" parent) ".l")))
|
||||
(widget (label name :bd 0 :relief "flat" :background "white"
|
||||
:env (the-environment))))
|
||||
;; Store in the image vector all the components of the animation
|
||||
(dotimes (i size)
|
||||
(let ((key (list-ref files i)))
|
||||
(vector-set! images
|
||||
i
|
||||
(make-image key :file key))))
|
||||
|
||||
;; Display the first image of the animation
|
||||
(tk-set! widget :image (vector-ref images 0))
|
||||
|
||||
;; Animate the image
|
||||
(letrec ((anim (let ((i 0))
|
||||
(lambda ()
|
||||
(when (winfo (quote exists) widget)
|
||||
(when (>= i size)
|
||||
(set! i 0))
|
||||
(tk-set! widget :image (vector-ref images i))
|
||||
(set! i (+ i 1))
|
||||
(update)
|
||||
(after delay anim))))))
|
||||
(after 'idle anim))
|
||||
widget))
|
||||
|
||||
|
||||
(define (change-animation-delay w delay)
|
||||
(let ((env (tk-get w :env)))
|
||||
(eval `(set! delay ,delay) env)))
|
||||
|
||||
|
||||
(define x (make-animation "/users/eg/PublicHtml/img*.gif" *root* 100))
|
||||
(pack x :fill "both" :expand #t)
|
||||
|
||||
(change-animation-delay x 1000)
|
||||
|
||||
|
|
@ -0,0 +1,34 @@
|
|||
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
|
||||
<html>
|
||||
<head>
|
||||
<title>Introduction à STk/STklos</title>
|
||||
</head>
|
||||
|
||||
<body bgcolor=white>
|
||||
<h1><img src="Images/STk-tiny.gif">Introduction à STk/STklos</h1>
|
||||
<p>
|
||||
<font size=+4>
|
||||
<B>STk</B> est un interprète Scheme:<p>
|
||||
<ul>
|
||||
<li>interfacé avec la boîte à outils graphique Tk<p>
|
||||
<li>permet de construire facilement des interfaces graphiques<p>
|
||||
</ul>
|
||||
<b>STklos</b> est l'extension objet de STk<p>
|
||||
<ul>
|
||||
<li> donne l'accès à la toolkit Tk sous forme objet<p>
|
||||
<li> simplifie l'utilisation de la toolkit Tk<p>
|
||||
|
||||
|
||||
</ul>
|
||||
Un exemple simple <A HREF=simple-fr.html>écrit</A> en STklos
|
||||
</font>
|
||||
<hr>
|
||||
<A HREF="main-fr.html"><img src="Images/backward.gif" align=middle> Retour</A>
|
||||
<hr>
|
||||
<address><a href="mailto:eg@unice.fr">Erick Gallesio</a></address>
|
||||
<!-- Created: Mon Mar 9 12:19:35 CET 1998 -->
|
||||
<!-- hhmts start -->
|
||||
Last modified: Mon Mar 9 18:59:57 CET 1998
|
||||
<!-- hhmts end -->
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,30 @@
|
|||
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
|
||||
<html>
|
||||
<head>
|
||||
<title>Présentation de STk</title>
|
||||
</head>
|
||||
|
||||
<body bgcolor=white>
|
||||
<h1><img src="Images/STk-tiny.gif">Présentation de STk</h1>
|
||||
<font size=+4>
|
||||
<ul>
|
||||
<li> <A HREF=intro-fr.html>Introduction</A><P>
|
||||
<li> Applications écrites en STk:<p>
|
||||
<ul>
|
||||
<li> Browser Web: <a href="S-scape-fr.html">S-scape</a><P>
|
||||
<li> Constructeur d'interfaces graphiques: <A HREF=amib-fr.html>
|
||||
AMIB</A><P>
|
||||
<li> Visualisation d'environnements en Scheme:
|
||||
<A HREF=envdraw-fr.html>Envdraw</A><P>
|
||||
</ul>
|
||||
<li> Definition de widgets <A HREF=compo-fr.html>composites</A>
|
||||
</ul>
|
||||
</font>
|
||||
<hr>
|
||||
<address><a href="mailto:eg@unice.fr">Erick Gallesio</a></address>
|
||||
<!-- Created: Mon Mar 9 12:11:25 CET 1998 -->
|
||||
<!-- hhmts start -->
|
||||
Last modified: Tue Mar 10 19:30:06 CET 1998
|
||||
<!-- hhmts end -->
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
|
||||
<html>
|
||||
<head>
|
||||
<title>Presentation of STk</title>
|
||||
</head>
|
||||
|
||||
<body bgcolor=#ffffff>
|
||||
<h1><img src="Images/STk-tiny.gif"></a>Presentation of STk / Présentation de STk</h1>
|
||||
<font size=+4>
|
||||
<p>
|
||||
<a href="main-fr.html"><img src="Images/fr.gif"></a>
|
||||
Présentation en Français.
|
||||
<p>
|
||||
<a href="main-en.html"><img src="Images/en.gif"></a>
|
||||
Presentation in (a kind of) English.
|
||||
</font>
|
||||
<hr>
|
||||
<address><a href="mailto:eg@unice.fr">Erick Gallesio</a></address>
|
||||
<!-- Created: Thu Mar 5 13:51:54 CET 1998 -->
|
||||
<!-- hhmts start -->
|
||||
Last modified: Mon Mar 9 12:38:04 CET 1998
|
||||
<!-- hhmts end -->
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1,66 @@
|
|||
;;;; puzzle.stk -- A puzzle written in STk (from the Tcl Demo)
|
||||
;;;;
|
||||
;;;; Copyright © 1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
;;;;
|
||||
;;;; Permission to use, copy, and/or distribute this software and its
|
||||
;;;; documentation for any purpose and without fee is hereby granted, provided
|
||||
;;;; that both the above copyright notice and this permission notice appear in
|
||||
;;;; all copies and derived works. Fees for distribution or use of this
|
||||
;;;; software or derived works may only be charged with express written
|
||||
;;;; permission of the copyright holder.
|
||||
;;;; This software is provided ``as is'' without express or implied warranty.
|
||||
;;;;
|
||||
;;;; $Id: puzzle.stk 1.1 Tue, 10 Mar 1998 21:43:37 +0100 eg $
|
||||
;;;;
|
||||
;;;; Author: Erick Gallesio [eg@unice.fr]
|
||||
;;;; Creation date: 9-Mar-1998 21:11
|
||||
;;;;Last file update: 9-Mar-1998 21:37
|
||||
|
||||
(define (display-puzzle parent)
|
||||
|
||||
(define (puzzle-switch w num xpos ypos space)
|
||||
(let ((x (vector-ref xpos num))
|
||||
(y (vector-ref ypos num))
|
||||
(x_spc (vector-ref xpos space))
|
||||
(y_spc (vector-ref ypos space)))
|
||||
(when (or (and (>= y (- y_spc 0.01)) (<= y (+ y_spc 0.01))
|
||||
(>= x (- x_spc 0.26)) (<= x (+ x_spc 0.26)))
|
||||
(and (>= x (- x_spc 0.01)) (<= x (+ x_spc 0.01))
|
||||
(>= y (- y_spc 0.26)) (<= y (+ y_spc 0.26))))
|
||||
(vector-set! xpos space x)
|
||||
(vector-set! xpos num x_spc)
|
||||
(vector-set! ypos space y)
|
||||
(vector-set! ypos num y_spc)
|
||||
(place w :relx x_spc :rely y_spc))))
|
||||
|
||||
(let ((order '#(3 1 6 2 5 7 15 13 4 11 8 9 14 10 12))
|
||||
(xpos (make-vector 16))
|
||||
(ypos (make-vector 16))
|
||||
(space 0)
|
||||
(f (frame (format #f "~A.f" (widget-name parent))
|
||||
:width 150 :height 150 :bd 4 :relief "solid")))
|
||||
|
||||
(do ((i 0 (+ i 1)))
|
||||
((= i 15))
|
||||
(let* ((num (vector-ref order i))
|
||||
(b (button (format #f "~A.b~A" (widget-name f) i) :text num
|
||||
:highlightthickness 0)))
|
||||
;; Set the command of the button (and grab current environment)
|
||||
(tk-set! b :command (lambda ()
|
||||
(puzzle-switch b num xpos ypos space)))
|
||||
|
||||
(vector-set! xpos num (* (modulo i 4) 0.25))
|
||||
(vector-set! ypos num (* (floor (/ i 4)) 0.25))
|
||||
|
||||
(place b :relx (vector-ref xpos num)
|
||||
:rely (vector-ref ypos num)
|
||||
:relwidth 0.25
|
||||
:relheight 0.25)))
|
||||
(vector-set! xpos space 0.75)
|
||||
(vector-set! ypos space 0.75)
|
||||
|
||||
(pack f :expand #t :fill "both")
|
||||
f))
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,39 @@
|
|||
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
|
||||
<html>
|
||||
<head>
|
||||
<title>Exemple en STklos</title>
|
||||
</head>
|
||||
|
||||
<body bgcolor=white>
|
||||
<h1><img src="Images/STk-tiny.gif">Exemple en STklos</h1>
|
||||
<font size=+6>
|
||||
Lancer un <b>xterm</b> pour tester ce <i>programme</i> avec
|
||||
<ul>
|
||||
<li> la version non installée de STk
|
||||
(<a expr=(system "xterm -e test-stk &")>test-stk</a>)
|
||||
<li> la version installée de STk
|
||||
(<a expr=(system "xterm -e stk &")>stk</a>)
|
||||
</ul>
|
||||
</font>
|
||||
<pre>
|
||||
(require "Tk-classes")
|
||||
(define l (make <Button>
|
||||
:text "Hello, world"
|
||||
:font "10x20"
|
||||
:command (lambda () (exit 0))))
|
||||
(pack l)
|
||||
</pre>
|
||||
<font size=+6>
|
||||
<b>Coupez</b> les 3 expressions précédentes et <b>Collez</b> les dans la
|
||||
fenêtre xterm dès que celle-ci apparaît.
|
||||
</font>
|
||||
<hr>
|
||||
<A HREF="main-fr.html"><img src="Images/backward.gif" align=middle> Retour</A>
|
||||
<hr>
|
||||
<address><a href="mailto:eg@unice.fr">Erick Gallesio</a></address>
|
||||
<!-- Created: Mon Mar 9 12:30:47 CET 1998 -->
|
||||
<!-- hhmts start -->
|
||||
Last modified: Tue Mar 10 18:18:42 CET 1998
|
||||
<!-- hhmts end -->
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -0,0 +1 @@
|
|||
../stklos-widgets.stklos
|
||||
|
|
@ -1,364 +1,442 @@
|
|||
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
|
||||
<html>
|
||||
<!-- Created by: Erick Gallesio, 1-Sep-1995 -->
|
||||
<head>
|
||||
<title>Demo directory README (Version 3.1 - July 1996)</title>
|
||||
</head>
|
||||
<body bgcolor="#FFFFFF">
|
||||
<h1><img src="STk-normal.gif"> Demo directory</h1>
|
||||
<pre>
|
||||
<head>
|
||||
<title>Demo directory README (Version 3.99 - March 1998)</title>
|
||||
</head>
|
||||
|
||||
<body bgcolor="#FFFFFF">
|
||||
<h1><img src="STk-normal.gif"> Demo directory</h1>
|
||||
|
||||
<! Applet definition: This applet defines new function which can run a demo
|
||||
using the SYSTEM function.
|
||||
This is VERY DANGEROUS, but user can set security to a given level
|
||||
when launching the browser.
|
||||
Security is not yet finished and need some work
|
||||
>
|
||||
|
||||
<script language="STk">
|
||||
(lambda (parent url)
|
||||
(eval '(define (Run x)
|
||||
(system (string-append "../Src/test-stk " x "&")))
|
||||
(global-environment))))
|
||||
</script>
|
||||
|
||||
|
||||
</pre>
|
||||
<p>This directory contains demo programs for <b>STk</b>.
|
||||
<! ------------------------------------------------------------------------------>
|
||||
<pre>
|
||||
|
||||
|
||||
<p>If you want to run a demo <STRONG>BEFORE</STRONG> a complete
|
||||
installation of the <b>STk</b> package, you must use the
|
||||
<pre> ../Src/test-stk</pre>
|
||||
command to run the interpreter.
|
||||
</pre>
|
||||
|
||||
<p><b>If you view this file with the STk HTML browser, you can click on
|
||||
each given command to launch a demo.</b><p>
|
||||
To use the STk HTML browser, just type:
|
||||
<pre> ../Src/test-stk -f hbrowse README.html</pre>
|
||||
<p><I>Happy STking </I>
|
||||
<h4>Content</h4>
|
||||
<ul>
|
||||
This directory contains the demo programs for <b>STk</b>.
|
||||
There are several categories of demos available from here:
|
||||
<ul>
|
||||
<li> <a href="README.html#stk">STk demos</a>: They correspond to
|
||||
program which don't use CLOS like object extension of
|
||||
<b>STk</b>. These demo are quite simple and they often mimic
|
||||
original Tcl/Tk demonstrations
|
||||
<li> <a href="README.html#stklos">STklos demos</a>: These
|
||||
demonstration programs use the STklos object Extension of
|
||||
<B>STk</B>. The code of most of these demos has been kept short
|
||||
to illustrate the basic of STklos programming.
|
||||
<li> <a href="Html-Demos/main.html">Html demo</a>: This demo is
|
||||
in fact an overview of STk/STklos that I have used once in a
|
||||
presentation of STklos. The pages accessible from this link
|
||||
present STk but also contains links or Scheme applets which
|
||||
illustrate the kind of things that can be done with the STk
|
||||
browser. Of course, to properly execute the applets contained
|
||||
in theses pages, you need to run the STk Html browser
|
||||
(see below).
|
||||
|
||||
</ul>
|
||||
</ul>
|
||||
<h4>Running demonstration programs without installing STk</h4>
|
||||
<ul>
|
||||
If you want to run a demo <STRONG>BEFORE</STRONG> a complete
|
||||
installation of the <b>STk</b> package, you must use the shell
|
||||
script <code>../Src/test-stk</code> in order to run the
|
||||
interpreter (this shell script set some variables to run properly
|
||||
the interpreter without installing it).
|
||||
</ul>
|
||||
<h4>Running demonstration programs in the STk web browser</h4>
|
||||
<ul>
|
||||
<b>STk</b> provides a simple Web browser which can be used to launch
|
||||
the demo of this directory. If you are not running it now, you can
|
||||
type the following command:
|
||||
<pre> ../Src/test-stk -f S-scape README.html</pre>
|
||||
at the shell prompt.
|
||||
</ul>
|
||||
|
||||
<hr></p>
|
||||
<h2>
|
||||
<center><font COLOR="red">STk demos</font></center>
|
||||
</h2>
|
||||
<hr>
|
||||
<h2><a name="stk">1. STk demos</a></h2>
|
||||
<h4>1.1 Basic STk demos</h4>
|
||||
|
||||
<UL>
|
||||
<p><li>
|
||||
<B><A name=hello>hello.stk</a></B>
|
||||
<BR>
|
||||
This is the traditional first program. This program creates a single button
|
||||
that you can click on.
|
||||
<BR>
|
||||
<u>Run with </u>:
|
||||
<a expr=(run "hello.stk")> ../Src/test-stk -f hello.stk </a>
|
||||
<p><li>
|
||||
<B><A name=browse>browse.stk</a></B>
|
||||
<BR>
|
||||
A simple Unix file browser. The code of this demo is less than a page.
|
||||
<BR>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "browse.stk")>.../Src/test-stk -f browse.stk </A>
|
||||
</UL>
|
||||
|
||||
<DL>
|
||||
<DT> File
|
||||
<DD> browse.stk
|
||||
<DT> Description
|
||||
<DD> a simple Unix file browser
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f browse.stk &")>
|
||||
../Src/test-stk -f browse.stk
|
||||
</A>
|
||||
</DL>
|
||||
<h4>1.2 Basics of STk programming</h4>
|
||||
<UL>
|
||||
<p><li>
|
||||
<B>wtour.stk</B>
|
||||
<BR>
|
||||
This is a rewrite of the Tcl/Tk wtour2.0 in Scheme/STk. Use
|
||||
the menus to navigate through different lessons. You can make
|
||||
changes to the lesson source code; click on the Apply button
|
||||
to see the results of the changes.
|
||||
<BR>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "wtour.stk ../Contrib/STk-wtour")>
|
||||
../Src/test-stk -f ./wtour.stk ../Contrib/STk-wtour
|
||||
</A>
|
||||
<BR><u>Comment</u>: This code is a contribution of <B>Suresh Srinivas</B>
|
||||
<tt><ssriniva@cs.indiana.edu></tt>
|
||||
</UL>
|
||||
|
||||
<hr>
|
||||
<DL>
|
||||
<DT> File
|
||||
<DD> colormap.stk
|
||||
<DT> Description
|
||||
<DD> a simple color builder
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f colormap.stk &")>
|
||||
../Src/test-stk -f colormap.stk
|
||||
</A>
|
||||
<DT> Comment
|
||||
<DD> On exit, the RGB value is printed on the sandard output
|
||||
</DL>
|
||||
<h4>1.3 Client/Server Demos</h4>
|
||||
<ul>
|
||||
<p><li>
|
||||
<b>server.stk</b>
|
||||
<br>
|
||||
A simple server showing how to use the socket package. It
|
||||
creates an xterm window in which a read-eval-print-loop is
|
||||
executed. When the window is closed or when an error occurs,
|
||||
the socket is closed
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "-no -f server.stk")> ../Src/test-stk -no -f server.stk </A>
|
||||
<p><li>
|
||||
<b>mc-server.stk</b>
|
||||
<br>
|
||||
A multiple-clients server. On Unix, you can use several telnet
|
||||
sessions to <I>discuss</I> with the server. Each discussion
|
||||
has its own dedicated channel. Type <tt>(exit)</tt> at the <b>STk</b>
|
||||
when you want to exit the demo.
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(system "xterm -e ../Src/test-stk -load mc-server.stk &")>
|
||||
../Src/test-stk -load mc-server.stk </A>
|
||||
</ul>
|
||||
|
||||
|
||||
<h4>1.4 Fun and Games</h4>
|
||||
<ul>
|
||||
<p><li>
|
||||
<b>turtle.stk</b>
|
||||
<br>
|
||||
A Logo turtle package + some demo functions.
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "turtle.stk")> ../Src/test-stk -f turtle.stk </A>
|
||||
<p><li>
|
||||
<b>hanoi.stk</b>
|
||||
<br>
|
||||
Hanoi towers animation.
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "hanoi.stk")> ../Src/test-stk -f hanoi.stk </A>
|
||||
<p><li>
|
||||
<b>queens.stk</b>
|
||||
<br>
|
||||
The queens problem. You can do it yourself (and it will make
|
||||
sure you follow the rules) or you can ask it to solve the
|
||||
puzzle starting with a given board configuration.
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "queens.stk")> ../Src/test-stk -f queens.stk </A>
|
||||
<br>
|
||||
<u>Comment</u>: This code is a contribution of <b>Grant
|
||||
Edwards</b> <tt><grante@rosemount.com)></tt>
|
||||
<p><li>
|
||||
<b>stetris.stk</b>
|
||||
<br>
|
||||
This is a falling block game not unlike tetris(tm) :). It is
|
||||
implemented in <b>STk</b> just to prove it can be done, and as a
|
||||
challenge to TCLers. It starts slowly and becomes faster and
|
||||
faster. Have fun.
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "stetris.stk")> ../Src/test-stk -f stetris.stk </A>
|
||||
<br>
|
||||
<u>Comment</u>:
|
||||
This code is a contribution of <B>Harvey J. Stein</B>
|
||||
<tt><hjstein@math.huji.ac.il></tt>
|
||||
|
||||
<p><li>
|
||||
<b>ttt.stk</b>
|
||||
<br>
|
||||
A 3D Tic-Tac-Toe, where the board is 4x4x4, a 3 dimensional
|
||||
board of four planes with four rows and four columns each.
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "ttt.stk")> ../Src/test-stk -f ttt.stk </A>
|
||||
<br>
|
||||
<u>Comment</u>:
|
||||
This code is a contribution of <b>Edin "Dino" Hodzic</b>
|
||||
<ehodzic@scu.edu>
|
||||
</ul>
|
||||
|
||||
|
||||
<h4>1.5 Misc </h4>
|
||||
<ul>
|
||||
<p><li>
|
||||
<b>colormap.stk</b>
|
||||
<br>
|
||||
This is a simple color palette written in STk.
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "colormap.stk")> ../Src/test-stk -f colormap.stk </A>
|
||||
<br>
|
||||
<u>Comment</u>: Note that this program is no more really useful since
|
||||
<B>STk</B> offers now the function <tt>Tk:choose-color</tt>
|
||||
which allow to choose a color by name or by value.
|
||||
|
||||
<p><li>
|
||||
<b>small-ed.stk</b>
|
||||
<br>
|
||||
A small editor to create enhanced text
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "small-ed.stk")> ../Src/test-stk -f small-ed.stk </A>
|
||||
<br>
|
||||
<u>Comment</u>:
|
||||
This editor use a <I>ad-hoc</I> format for saving file and was
|
||||
used for the help buttons of various widgets in old versions
|
||||
of <B>STk</B>. It will not be developed anymore since the
|
||||
preferred format for help is now HTML.
|
||||
|
||||
<p><li>
|
||||
<b>showvars.stk</b>
|
||||
<br>
|
||||
A variable shower: this program shows the value of three
|
||||
variables (named a,b and c) Changing the value of one of
|
||||
these vars (with a <tt><b>set!</b></tt> for instance) will
|
||||
redisplay its new value immediately.
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "-load showvars.stk")>
|
||||
../Src/test-stk -load showvars.stk </A>
|
||||
<br>
|
||||
|
||||
<p><li>
|
||||
<b>inspector.stk</b>
|
||||
<br>
|
||||
A simple demo of the inspector on Tk widgets
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "inspector.stk")> ../Src/test-stk -f inspector.stk </A>
|
||||
<br>
|
||||
<u>Comment</u>:
|
||||
<STRONG> Does not work with this version of <I>STk</I>
|
||||
<BR>A new version of the inspector is in practically finished and
|
||||
will be soon released.</STRONG>
|
||||
|
||||
<p><li>
|
||||
<b>term.stk</b>
|
||||
<br>
|
||||
A simple terminal emulator (a kind of xterm, but in a text widget).
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "term.stk")> ../Src/test-stk -f term.stk </A>
|
||||
<br>
|
||||
<u>Comment</u>: Users of <b>Glibc2 (aka libc6, or RedHat 5.0
|
||||
users)</b>: This program has problems with new release of the
|
||||
libc under Linux, if your shell has the line editing mode
|
||||
set. To avoid the problem you can
|
||||
<ul>
|
||||
<li> disable the line editing mode of your shell
|
||||
<li> set the SHELL variable to a dumb shell (e.g. ash)
|
||||
<li> link STk with the old libc
|
||||
<li> don't run the demo :-)
|
||||
</ul>
|
||||
</ul>
|
||||
|
||||
|
||||
<! -------------------------------------------------------------------------->
|
||||
|
||||
<h2><a name="stklos">2. STklos demos</a></h2>
|
||||
<ul>
|
||||
All the standard Tk widgets have been wrapped in <b>STklos</b>
|
||||
classes. As a result, in <b>STklos</b>, Tk widgets are seen as instances of
|
||||
<b>STklos</b> classes.
|
||||
<br> There are two kinds of <b>STklos</b> widgets:
|
||||
<ul>
|
||||
<li> <i>Simple widgets</i> which map one to one the Tk standard
|
||||
widgets
|
||||
|
||||
<li> <i>Composite widgets</i> which are built from simple Tk
|
||||
widgets (or even simpler composite widgets).
|
||||
</ul>
|
||||
Demonstration programs accessible from this page use indifferently
|
||||
<i>simple widgets</i> and <i>composite widgets</i>.
|
||||
</ul>
|
||||
|
||||
<h4>2.1 Basic STklos demos</h4>
|
||||
|
||||
<ul>
|
||||
<p><li>
|
||||
<b>hello.stklos</b>
|
||||
<br>
|
||||
This is a simple rewriting of the <a HREF=#hello>hello.stk</a>
|
||||
demonstration in <b>STklos</b>
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "hello.stklos")> ../Src/test-stk -f hello.stklos </A>
|
||||
|
||||
<p><li>
|
||||
<b>browse.stklos</b>
|
||||
<br>
|
||||
This is a simple rewriting of the <a HREF=#browse>browse.stk</a>
|
||||
demonstration in <b>STklos</b>
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "browse.stklos")> ../Src/test-stk -f browse.stklos </A>
|
||||
|
||||
|
||||
|
||||
<p><li>
|
||||
<b>stklos-demo.stklos</b>
|
||||
A simple demo written in STklos.
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "stklos-demo.stklos")>../Src/test-stk -f stklos-demo.stklos</a>
|
||||
<br>
|
||||
<u>Comment</u>: What is interesting in this demo is not what
|
||||
it does, nothing specially fancy, but how it is easy to
|
||||
program, IMHO.
|
||||
|
||||
<p><li>
|
||||
<b>stklos-demo2.stklos</b>
|
||||
Another simple demo written in STklos.
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "stklos-demo2.stklos")>
|
||||
../Src/test-stk -f stklos-demo2.stklos</a>
|
||||
<br>
|
||||
<u>Comment</u>: Here again, what is interesting in this demo is not what
|
||||
it does, nothing specially fancy, but how it is easy to
|
||||
program, IMHO.
|
||||
</ul>
|
||||
|
||||
<h4>2.2 STklos widgets</h4>
|
||||
|
||||
<ul>
|
||||
<p><li>
|
||||
<b>widget.stklos</b>
|
||||
<br>
|
||||
A tour of the Tk widgets. This demo shows all the Tk
|
||||
widgets. This is a rewriting in STklos of the big Tcl/Tk demo
|
||||
<tt>widget.tcl</tt>. For each widget demo accessible from this
|
||||
program, you can see the source by just clicking the <tt>"See
|
||||
code"</tt> button. You can modify the code and test your
|
||||
modified version by clicking the button <tt>"Rerun demo"</tt>
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "widget.stk")> ../Src/test-stk -f widget.stk </A>
|
||||
<br>
|
||||
<u>Comment</u>: This demo illustrate only the simple widgets
|
||||
(the ones of the Tk library). For a <i>composite widgets</i>
|
||||
demo look at the <tt>stklos-widgets.stklos</tt> program.
|
||||
|
||||
<p><li>
|
||||
<b>filebox.stklos</b>
|
||||
<br>
|
||||
This is a simple program which uses the <tt><File-box></tt>
|
||||
<i>composite widget</i>. A <tt><File-box></tt> is a file requester
|
||||
with file name completion (on the <tt>Tab</tt> key).This widget is
|
||||
itself a composition of various composite widget classes.
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "filebox.stklos")> ../Src/test-stk -f filebox.stklos </A>
|
||||
|
||||
<p><li>
|
||||
<b>stklos-widgets.stklos</b>
|
||||
<br>
|
||||
A quick demo of some of the STklos <i>Composite widgets</i>
|
||||
which are available in this release.
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "stklos-widgets.stklos")>
|
||||
../Src/test-stk -f stklos-widgets.stklos </A>
|
||||
<br>
|
||||
<u>Comment</u>: This code is a contribution of <b>Drew Whitehouse</b>
|
||||
<TT><Drew.Whitehouse@anu.edu.au></TT>.
|
||||
</ul>
|
||||
|
||||
|
||||
<h4>2.3 STklos Applications</h4>
|
||||
<ul>
|
||||
<p><li>
|
||||
<b>calc.stklos</b>
|
||||
<br>
|
||||
This is a simplistic calculator.
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "calc.stklos")>../Src/test-stk -f calc.stklos </A>
|
||||
|
||||
<p><li>
|
||||
<b>tkcolor.stklos</b>
|
||||
<br>
|
||||
This is a simple color picker written in <B>STklos</B>.
|
||||
Clicking the left mouse button in the color box sets the text
|
||||
color to the chosen color. Clicking the right button sets the
|
||||
background color. The <i>Select</i> button sets the selection
|
||||
to a string which can be used (by pasting it in an xterm window)
|
||||
as argument of most X11 applications to set their foreground and
|
||||
background color.
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "tkcolor.stklos")>../Src/test-stk -f tkcolor.stklos </A>
|
||||
|
||||
<p><li>
|
||||
<b>amib.stklos</b>
|
||||
<br>
|
||||
<B>A</B> <B>M</B>ini <B>I</B>nterface <B>B</B>uilder.
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "amib.stklos")> ../Src/test-stk -f amib.stklos </A>
|
||||
<br>
|
||||
<u>Comment</u>: The current version of AMIB allow you to:
|
||||
<ul>
|
||||
<li>place objects on a plane by drag and drop
|
||||
<li>resize objects
|
||||
<li>displace objects
|
||||
<li>change all the slots of an object (color, font, value, ...)
|
||||
<li>save an interface to reload it later in an application
|
||||
</ul>
|
||||
However it is far from a really usable interface builder (but
|
||||
after all it is only a 600 lines of code application!!!!)
|
||||
|
||||
<p><li>
|
||||
<b>S-scape.stklos</b>
|
||||
<br>
|
||||
The STk web browser. You are probably using it while seeing these lines.
|
||||
<br>
|
||||
<u>Run with</u>:
|
||||
<A expr=(run "S-scape.stklos")> ../Src/test-stk -f S-scape.stklos </A>
|
||||
</ul>
|
||||
|
||||
|
||||
<hr>
|
||||
<DL>
|
||||
<DT> File
|
||||
<DD> small-ed.stk
|
||||
<DT> Description
|
||||
<DD> A small editor to create enhanced text
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f small-ed.stk &")>
|
||||
../Src/test-stk -f small-ed.stk
|
||||
</A>
|
||||
<DT> Comment
|
||||
<DD> <STRONG> Does not work (still) with <I>STk</I> 3.0</STRONG>
|
||||
</DL>
|
||||
<address><a href="mailto:eg@unice.fr">Erick Gallesio</a></address>
|
||||
<!-- Created: Sun Mar 1 15:56:45 CET 1998 -->
|
||||
<!-- hhmts start -->
|
||||
Last modified: Mon Mar 9 19:15:46 CET 1998
|
||||
<!-- hhmts end -->
|
||||
</body>
|
||||
</html>
|
||||
|
||||
<hr>
|
||||
<DL>
|
||||
<DT> File
|
||||
<DD> hanoi.stk
|
||||
<DT> Description
|
||||
<DD> Hanoi towers animation
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f hanoi.stk &")>
|
||||
../Src/test-stk -f hanoi.stk
|
||||
</A>
|
||||
</DL>
|
||||
|
||||
<hr>
|
||||
<DL>
|
||||
<DT> File
|
||||
<DD> hello.stk
|
||||
<DT> Description
|
||||
<DD> a simple button demonstration
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f hello.stk &")>
|
||||
../Src/test-stk -f hello.stk
|
||||
</A>
|
||||
</DL>
|
||||
|
||||
<hr>
|
||||
<DL>
|
||||
<DT> File
|
||||
<DD> showvars.stk
|
||||
<DT> Description
|
||||
<DD> a variable shower<br>
|
||||
This program shows the value of three variables (named a,b and c)
|
||||
Changing the value of one of these vars (with a set! for
|
||||
instance) will redisplay its new value immediatly
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -load showvars.stk &")>
|
||||
../Src/test-stk -load showvars.stk
|
||||
</A>
|
||||
<DT> Comment
|
||||
<DT> Exit
|
||||
<DD> type (exit) on the STk prompt
|
||||
</DL>
|
||||
|
||||
<hr>
|
||||
<DL>
|
||||
<DT> File
|
||||
<DD> turtle.stk
|
||||
<DT> Description
|
||||
<DD> a Logo turtle package + some demo functions.
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f turtle.stk &")>
|
||||
../Src/test-stk -f turtle.stk
|
||||
</A>
|
||||
</DL>
|
||||
|
||||
<hr>
|
||||
<DL>
|
||||
<DT> File
|
||||
<DD> inspector.stk
|
||||
<DT> Description
|
||||
<DD> A simple demo of the inspector on Tk widgets
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f inspector.stk &")>
|
||||
../Src/test-stk -f inspector.stk
|
||||
</A>
|
||||
<DT> Comment
|
||||
<DD> <STRONG> Does not work (still) with <I>STk</I> 3.0</STRONG>
|
||||
</DL>
|
||||
|
||||
<hr>
|
||||
<DL>
|
||||
<DT> File
|
||||
<DD> mc-server.stk
|
||||
<DT> Description
|
||||
<DD> A multiple-clients server.
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "xterm -e ../Src/test-stk -load mc-server.stk &")>
|
||||
../Src/test-stk -load mc-server.stk
|
||||
</A>
|
||||
</DL>
|
||||
|
||||
<hr>
|
||||
<DL>
|
||||
<DT> File
|
||||
<DD> queens.stk
|
||||
<DT> Description
|
||||
<DD> The queens problem. You can do it yourself (and it will make
|
||||
sure you follow the rules) or you can ask it to solve the
|
||||
puzzle starting with a given board configuration.
|
||||
<b>This code is a contribution of Grant Edwards</b>
|
||||
<tt>(grante@rosemount.com)</tt>
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f queens.stk &")>
|
||||
../Src/test-stk -f queens.stk
|
||||
</A>
|
||||
</DL>
|
||||
|
||||
|
||||
<hr>
|
||||
<DL><DT>File
|
||||
<DD> stetris.stk
|
||||
<DT> Description
|
||||
<DD> This is a falling block game not unlike tetris(tm) :).
|
||||
It is implemented in STk just to prove it can be done,
|
||||
and as a challenge to TCLers.
|
||||
It starts slowly and becomes faster and faster.
|
||||
Have fun.
|
||||
This code is a contribution of Harvey J. Stein(hjstein@math.huji.ac.il)
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f stetris.stk &")>
|
||||
../Src/test-stk -f stetris.stk
|
||||
</A>
|
||||
</DL>
|
||||
|
||||
|
||||
<hr>
|
||||
<DL><DT>File
|
||||
<DD> ttt.stk
|
||||
<DT> Description
|
||||
<DD> A 3D Tic-Tac-Toe, where the board is 4x4x4, a 3 dimensional board
|
||||
of four planes with four rows and four columns each.
|
||||
<B>This code is a contribution of Edin "Dino" Hodzic</B> <ehodzic@scu.edu>
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f ttt.stk &")>
|
||||
../Src/test-stk -f ttt.stk
|
||||
</A>
|
||||
</DL>
|
||||
|
||||
<hr>
|
||||
<DL><DT>File
|
||||
<DD> server.stk
|
||||
<DT> Description
|
||||
<DD> A simple server showing how to use the socket package.
|
||||
It creates a xterm window in which a read-eval-print-loop
|
||||
is executed. When the window is closed or when an error occurs,
|
||||
the socket is closed
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f server.stk &")>
|
||||
../Src/test-stk -f server.stk
|
||||
</A>
|
||||
</DL>
|
||||
|
||||
<hr>
|
||||
<DL><DT>File
|
||||
<DD> term.stk
|
||||
<DT> Description
|
||||
<DD> A simple terminal emulator (a kind of xterm, but in a text widget).
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f ./term.stk &")>
|
||||
../Src/test-stk -f term.stk
|
||||
</A>
|
||||
</DL>
|
||||
|
||||
<hr>
|
||||
<DL><DT>File
|
||||
<DD> wtour.stk
|
||||
<DT> Description
|
||||
<DD> This is a rewrite of the Tcl/Tk wtour2.0 in Scheme/STk. Use the menus
|
||||
to navigate through different lessons. You can make changes
|
||||
to the lesson source code; click on the Apply button to see the results of
|
||||
the changes.
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f ./wtour.stk ../Contrib/STk-wtour &")>
|
||||
../Src/test-stk -f ./wtour.stk ../Contrib/STk-wtour
|
||||
</A>
|
||||
</DL>
|
||||
|
||||
<!-- --------------------------------------------------------------------------->
|
||||
<hr>
|
||||
<h2>
|
||||
<center><font COLOR="red"> STklos demos </font></center>
|
||||
</h2>
|
||||
<hr>
|
||||
<!-- --------------------------------------------------------------------------->
|
||||
|
||||
There are few demos of STklos. What is interesting is not what they do but
|
||||
how they are programmmed (IMO).
|
||||
|
||||
<hr>
|
||||
<DL>
|
||||
<DT> File
|
||||
<DD> widget.stklos
|
||||
<DT> Description
|
||||
<DD> A tour of the Tk widgets. This demo shows all the Tk widgets
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f widget.stk &")>
|
||||
../Src/test-stk -f widget.stklos
|
||||
</A>
|
||||
</DL>
|
||||
|
||||
|
||||
<hr>
|
||||
<DL><DT>File
|
||||
<DD> stklos-demo.stklos
|
||||
<DT> Description
|
||||
<DD> a simple demo written in STklos
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f stklos-demo.stklos &")>
|
||||
../Src/test-stk -f stklos-demo.stklos
|
||||
</A>
|
||||
</DL>
|
||||
|
||||
|
||||
<hr>
|
||||
<DL><DT>File
|
||||
<DD> stklos-demo2.stklos
|
||||
<DT> Description
|
||||
<DD> another simple demo written in STklos
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f stklos-demo2.stklos &")>
|
||||
../Src/test-stk -f stklos-demo2.stklos
|
||||
</A>
|
||||
</DL>
|
||||
|
||||
|
||||
<hr>
|
||||
<DL><DT>File
|
||||
<DD> hello.stklos
|
||||
<DT> Description
|
||||
<DD> a rewriting of the hello.stk demo in STklos
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f hello.stklos &")>
|
||||
../Src/test-stk -f hello.stklos
|
||||
</A>
|
||||
</DL>
|
||||
|
||||
<hr>
|
||||
<DL><DT>File
|
||||
<DD> browse.stklos
|
||||
<DT> Description
|
||||
<DD> a rewriting of the browse.stk demo in STklos
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f browse.stklos &")>
|
||||
../Src/test-stk -f browse.stklos
|
||||
</A>
|
||||
</DL>
|
||||
|
||||
|
||||
<hr>
|
||||
<DL><DT>File
|
||||
<DD> calc.stklos
|
||||
<DT> Description
|
||||
<DD> a very simple calculator
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f calc.stklos &")>
|
||||
../Src/test-stk -f calc.stklos
|
||||
</A>
|
||||
</DL>
|
||||
|
||||
|
||||
<hr>
|
||||
<DL><DT>File
|
||||
<DD> compo-demo.stklos
|
||||
<DT> Description
|
||||
<DD> A quick demo of the composite widgets which are in the STk release.
|
||||
<BR>
|
||||
<STRONG>This code is a contribution of </STRONG>
|
||||
<TT><Drew.Whitehouse@anu.edu.au></TT>
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f compo-demo.stklos &")>
|
||||
../Src/test-stk -f compo-demo.stklos
|
||||
</A>
|
||||
</DL>
|
||||
|
||||
|
||||
<hr>
|
||||
<DL><DT>File
|
||||
<DD> filebox.stklos
|
||||
<DT> Description
|
||||
<DD> a simple program which uses the <File-box> compositeclass.
|
||||
A <File-box> is a file requestor with file name completion.
|
||||
It is a composition of various composite widget classes.
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f filebox.stklos &")>
|
||||
../Src/test-stk -f filebox.stklos
|
||||
</A>
|
||||
</DL>
|
||||
|
||||
|
||||
<hr>
|
||||
<DL><DT>File
|
||||
<DD> tkcolor.stklos
|
||||
<DT> Description
|
||||
<DD> a simple color picker written in STklos. Clicking button 1 on the color
|
||||
box sets the text color to that color; Clicking button 3 sets the background.
|
||||
<DT> Run
|
||||
<DD> <A expr=(system "../Src/test-stk -f tkcolor.stklos &")>
|
||||
../Src/test-stk -f tkcolor.stklos
|
||||
</A>
|
||||
</DL>
|
||||
|
||||
<hr>
|
||||
<address>eg@unice.fr</address>
|
||||
</BODY>
|
||||
</HTML>
|
||||
|
|
|
|||
|
|
@ -0,0 +1,25 @@
|
|||
#!/bin/sh
|
||||
:; exec /usr/local/bin/stk -f "$0" "$@"
|
||||
;;;;
|
||||
;;;; S - s c a p e . s t k l o s -- A simple WEB browser
|
||||
;;;;
|
||||
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
;;;;
|
||||
;;;; Permission to use, copy, and/or distribute this software and its
|
||||
;;;; documentation for any purpose and without fee is hereby granted, provided
|
||||
;;;; that both the above copyright notice and this permission notice appear in
|
||||
;;;; all copies and derived works. Fees for distribution or use of this
|
||||
;;;; software or derived works may only be charged with express written
|
||||
;;;; permission of the copyright holder.
|
||||
;;;; This software is provided ``as is'' without express or implied warranty.
|
||||
;;;;
|
||||
;;;; Author: Erick Gallesio [eg@unice.fr]
|
||||
;;;; Creation date: 3-Nov-1996 18:44
|
||||
;;;; Last file update: 2-Mar-1998 09:42
|
||||
;;;;
|
||||
|
||||
(require "www-browser")
|
||||
|
||||
(apply WWW:browser
|
||||
:parent *top-root*
|
||||
(if (> *argc* 0) (list :url (car *argv*)) '()))
|
||||
|
|
@ -1 +1 @@
|
|||
../Lib/images/STk-normal.gif
|
||||
../Lib/Images/STk-normal.gif
|
||||
|
|
@ -44,7 +44,7 @@
|
|||
(if (> (winfo 'depth cnv) 1)
|
||||
`(:fill "SkyBlue1")
|
||||
`(:fill black
|
||||
:stipple ,(& "@" *stk-library* "/images/grey.25"))))
|
||||
:stipple ,(& "@" *stk-library* "/Images/grey.25"))))
|
||||
|
||||
(let ((xtip (- x2 (* 10 b)))
|
||||
(delta-y (+ (* 10 c) (* 5 width))))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,69 @@
|
|||
;;;;
|
||||
;;;; STk adaptation of the Tk widget demo.
|
||||
;;;;
|
||||
;;;; This demonstration script creates a simple canvas that can be
|
||||
;;;; scrolled in two dimensions.
|
||||
;;;;
|
||||
|
||||
(require "Tk-classes")
|
||||
|
||||
(define canv-old-fill "")
|
||||
(define canv-current-item #f)
|
||||
|
||||
(define (demo-cscroll)
|
||||
(define w (make-demo-toplevel "cscroll"
|
||||
"Scrollable Canvas Demonstration"
|
||||
"This window displays a canvas widget that can be scrolled either using the scrollbars or by dragging with button 2 in the canvas. If you click button 1 on one of the rectangles, its indices will be printed on stdout."))
|
||||
(define (scroll-enter)
|
||||
(let* ((item (car (find-items c 'with 'current)))
|
||||
(rect (if (is-a? item <Rectangle>)
|
||||
item
|
||||
(Cid->instance c (- (Cid item) 1)))))
|
||||
|
||||
(set! canv-current-item rect)
|
||||
(when (> (winfo 'depth c) 1)
|
||||
(set! canv-old-fill (fill rect))
|
||||
(set! (fill rect) "RoyalBlue1"))))
|
||||
|
||||
(define (scroll-leave)
|
||||
(when (and canv-current-item (> (winfo 'depth c) 1))
|
||||
(set! (fill canv-current-item) canv-old-fill)
|
||||
(set! canv-current-item #f)))
|
||||
|
||||
(define (scroll-button)
|
||||
(let* ((item (car (find-items c 'with 'current)))
|
||||
(txt (if (is-a? item <Text-item>)
|
||||
item
|
||||
(Cid->instance c (+ (Cid item) 1)))))
|
||||
(format #t "You buttoned at ~A\n" (text-of txt))))
|
||||
|
||||
(define c (make <Scroll-Canvas> :parent w :scroll-region '(-11c -11c 20c 20c)
|
||||
:h-scroll-side "bottom" :border-width 2 :relief "raised"))
|
||||
|
||||
;; Make internal objects
|
||||
(let ((bg (background c)))
|
||||
(dotimes (i 10)
|
||||
(let ((x (+ -10 (* 3 i)))
|
||||
(y -10))
|
||||
(dotimes (j 10)
|
||||
(make <Rectangle> :parent c
|
||||
:ouline "black" :fill bg :tags "rect"
|
||||
:coords (read-from-string (format #f "(~Ac ~Ac ~Ac ~Ac)"
|
||||
x y (+ x 2) (+ y 2))))
|
||||
(make <Text-item> :parent c :text (cons i j) :anchor 'center
|
||||
:font "fixed"
|
||||
:tags "text" :coords (read-from-string
|
||||
(format #f "(~Ac ~Ac)"
|
||||
(+ x 1) (+ y 1))))
|
||||
(set! y (+ y 3))))))
|
||||
|
||||
;; Pack canvas
|
||||
(pack c :fill "both" :expand #t)
|
||||
|
||||
;; Some bindings
|
||||
(bind c "all" "<Any-Enter>" scroll-enter)
|
||||
(bind c "all" "<Any-Leave>" scroll-leave)
|
||||
(bind c "all" "<1>" scroll-button)
|
||||
|
||||
(bind c "<2>" (lambda (x y) (scan c 'mark x y)))
|
||||
(bind c "<B2-Motion>" (lambda (x y) (scan c 'dragto x y))))
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -4,8 +4,7 @@
|
|||
;;;; This demonstration script displays two image widgets.
|
||||
;;;;
|
||||
|
||||
(require "Button")
|
||||
(require "Image")
|
||||
(require "Tk-classes")
|
||||
|
||||
(define (demo-image1)
|
||||
(let ((w (make-demo-toplevel "image1"
|
||||
|
|
|
|||
|
|
@ -0,0 +1,143 @@
|
|||
;;;;
|
||||
;;;; STk adaptation of the Tk widget demo.
|
||||
;;;;
|
||||
;;;; This demonstration script creates a canvas widget that displays a ruler
|
||||
;;;; with tab stops that can be set, moved, and deleted.
|
||||
;;;;
|
||||
(require "Tk-classes")
|
||||
|
||||
(define ruler-x 0)
|
||||
(define ruler-y 0)
|
||||
(define ruler-grid '.25c)
|
||||
(define ruler-left 0)
|
||||
(define ruler-right 0)
|
||||
(define ruler-top 0)
|
||||
(define ruler-bottom 0)
|
||||
(define ruler-size 0)
|
||||
(define ruler-item #f)
|
||||
|
||||
(define (demo-ruler)
|
||||
(define w (make-demo-toplevel "ruler"
|
||||
"Ruler Demonstration"
|
||||
"This canvas widget shows a mock-up of a ruler. You can create tab stops by dragging them out of the well to the right of the ruler. You can also drag existing tab stops. If you drag a tab stop far enough up or down so that it turns dim, it will be deleted when you release the mouse button."))
|
||||
|
||||
(define c (make <Canvas> :parent w :width '14.8c :height '2.5c))
|
||||
|
||||
(define (make-coords fmt . args)
|
||||
(read-from-string (apply format #f (string-append "(" fmt ")") args)))
|
||||
|
||||
(pack c :fill "x")
|
||||
|
||||
(make <Line> :parent c :coords '(1c 0.5c 1c 1c 13c 1c 13c 0.5c) :width 1)
|
||||
(dotimes (i 12)
|
||||
(let ((x (+ i 1)))
|
||||
(make <Line> :parent c :coords (make-coords "~Ac 1c ~Ac 0.6c" x x))
|
||||
(make <Line> :parent c :coords (make-coords "~A.25c 1c ~A.25c 0.8c" x x))
|
||||
(make <Line> :parent c :coords (make-coords "~A.5c 1c ~A.5c 0.7c" x x))
|
||||
(make <Line> :parent c :coords (make-coords "~A.75c 1c ~A.75c 0.8c" x x))
|
||||
|
||||
(make <Text-item> :parent c :coords (make-coords "~A.15c .75c" x)
|
||||
:text i :anchor 'sw)))
|
||||
|
||||
(let ((r (make <Rectangle> :parent c :coords '(13.2c 1c 13.8c 0.5c)
|
||||
:outline "black" :fill (background c)))
|
||||
(tab (make-ruler-tab c (winfo 'pixels c '13.5c) (winfo 'pixels c '.65c))))
|
||||
(add-tag r "weel")
|
||||
(add-tag tab "weel")
|
||||
(bind c "weel" "<1>" (lambda (x y) (ruler-new-tab c x y)))
|
||||
(bind c "tab" "<1>" (lambda (x y) (ruler-select-tab c x y)))
|
||||
(bind c "<B1-Motion>" (lambda (x y) (ruler-move-tab c x y)))
|
||||
(bind c "<Any-ButtonRelease-1>" (lambda () (ruler-release-tab c))))
|
||||
|
||||
(set! ruler-left (winfo 'fpixels c '1c))
|
||||
(set! ruler-right (winfo 'fpixels c '13c))
|
||||
(set! ruler-top (winfo 'fpixels c '1c))
|
||||
(set! ruler-bottom (winfo 'fpixels c '1.5c))
|
||||
(set! ruler-size (winfo 'fpixels c '.2c)))
|
||||
|
||||
|
||||
|
||||
;;;; make-ruler-tab --
|
||||
;;;; This procedure creates a new triangular polygon in a canvas to
|
||||
;;;; represent a tab stop.
|
||||
|
||||
(define (make-ruler-tab c x y)
|
||||
(let ((size [winfo 'pixels c '.2c]))
|
||||
(make <Polygon> :parent c :fill 'black
|
||||
:coords (list x y (+ x size) (+ y size) (- x size) (+ y size)))))
|
||||
|
||||
;;;; ruler-new-tab --
|
||||
;;;; Does all the work of creating a tab stop, including creating the
|
||||
;;;; triangle object and adding tags to it to give it tab behavior.
|
||||
|
||||
(define (ruler-new-tab c x y)
|
||||
(let ((tab (make-ruler-tab c x y)))
|
||||
(add-tag tab "active")
|
||||
(add-tag tab "tab")
|
||||
(set! ruler-x x)
|
||||
(set! ruler-y y)
|
||||
(set! ruler-item tab)
|
||||
(ruler-move-tab c x y)))
|
||||
|
||||
;;;; ruler-select-tab --
|
||||
;;;; This procedure is invoked when mouse button 1 is pressed over
|
||||
;;;; a tab. It remembers information about the tab so that it can
|
||||
;;;; be dragged interactively.
|
||||
;;;;
|
||||
(define (ruler-select-tab c x y)
|
||||
(add-tag c "active" 'withtag 'current)
|
||||
(raise c "active")
|
||||
|
||||
(set! ruler-x (canvas-x c x ruler-grid))
|
||||
(set! ruler-y (+ ruler-top 2))
|
||||
(set! ruler-item (car (find-items c 'withtag "active")))
|
||||
(ruler-set-style! ruler-item 'active)
|
||||
)
|
||||
|
||||
;;;; ruler-move-tab --
|
||||
;;;; This procedure is invoked during mouse motion events to drag a tab.
|
||||
;;;; It adjusts the position of the tab, and changes its appearance if
|
||||
;;;; it is about to be dragged out of the ruler.
|
||||
|
||||
(define (ruler-move-tab c x y)
|
||||
(let ((active (find-items c 'withtag "active")))
|
||||
(unless (null? active)
|
||||
(let ((cx (canvas-x c x ruler-grid))
|
||||
(cy (canvas-y c y)))
|
||||
(if (< cx ruler-left) (set! cx ruler-left))
|
||||
(if (> cx ruler-right) (set! cx ruler-right))
|
||||
(if (and (>= cy ruler-top) (<= cy ruler-bottom))
|
||||
(begin
|
||||
(set! cy (+ ruler-top 2))
|
||||
(ruler-set-style! ruler-item 'active)
|
||||
)
|
||||
(begin
|
||||
(set! cy (- cy ruler-size 2))
|
||||
(ruler-set-style! ruler-item 'delete)
|
||||
))
|
||||
(move (car active) (- cx ruler-x) (- cy ruler-y))
|
||||
(set! ruler-x cx)
|
||||
(set! ruler-y cy)))))
|
||||
|
||||
;;;; ruler-release-tab --
|
||||
;;;; This procedure is invoked during button release events that end
|
||||
;;;; a tab drag operation. It deselects the tab and deletes the tab if
|
||||
;;;; it was dragged out of the ruler.
|
||||
|
||||
(define (ruler-release-tab c)
|
||||
(let ((active (find-items c 'withtag "active")))
|
||||
(unless (null? active)
|
||||
(if (= ruler-y (+ ruler-top 2))
|
||||
(begin
|
||||
(ruler-set-style! ruler-item 'normal)
|
||||
(delete-tag c "active"))
|
||||
(canvas-delete c "active")))))
|
||||
|
||||
;;;; ruler-set-style!
|
||||
;;;; Set the style of the tab
|
||||
(define (ruler-set-style! tab style)
|
||||
(case style
|
||||
((active) (when (> (winfo 'depth (parent tab)) 1) (slot-set! tab 'fill "red"))
|
||||
(slot-set! tab 'stipple ""))
|
||||
((delete) (slot-set! tab 'stipple 'gray25))
|
||||
((normal) (slot-set! tab 'fill "black"))))
|
||||
|
|
@ -5,6 +5,8 @@
|
|||
;;;; embedded windows.
|
||||
;;;;
|
||||
|
||||
(define demo-wind-toggle "Short")
|
||||
|
||||
(define (demo-wind)
|
||||
|
||||
(define embedded-canvas #f)
|
||||
|
|
|
|||
|
|
@ -1,282 +0,0 @@
|
|||
#!/bin/sh
|
||||
:;exec /usr/local/bin/stk -f "$0" "$@"
|
||||
;;;;
|
||||
;;;; STk adaptation of the Tk widget demo.
|
||||
;;;;
|
||||
;;;; This script demonstrates the various widgets provided by Tk, along
|
||||
;;;; with many of the features of the Tk toolkit. This file only
|
||||
;;;; contains code to generate the main window for the application,
|
||||
;;;; which invokes individual demonstrations. The code for the actual
|
||||
;;;; demonstrations is contained in separate ".stklos" files in this
|
||||
;;;; directory, which are sourced by this script as needed.
|
||||
|
||||
(require "Tk-classes")
|
||||
|
||||
(define demo-font "-*-Helvetica-Medium-R-Normal--*-140-*-*-*-*-*-*")
|
||||
(define *STk-images* (string-append *STk-library* "/images/"))
|
||||
(set! *load-path* `("./Widget"
|
||||
,(string-append *STk-library* "/demos")
|
||||
,@*load-path*))
|
||||
|
||||
;;
|
||||
;; make-demo-toplevel
|
||||
;;
|
||||
(define (make-demo-toplevel name title text . variables)
|
||||
(let* ((t (make <Toplevel> :title title :geometry "+300+300"))
|
||||
(f (make <Frame> :parent t))
|
||||
(b (make <Frame> :parent t)))
|
||||
|
||||
;; Pack the demo text
|
||||
(when text
|
||||
(pack (make <Label> :font demo-font
|
||||
:parent t
|
||||
:wrap-length "4i"
|
||||
:justify "left"
|
||||
:text text)
|
||||
:side "top" :expand #f :fill "both"))
|
||||
|
||||
;; Pack the frame where the demo will be done
|
||||
(pack f :side "top" :expand #t :fill "both")
|
||||
|
||||
;; Add the two bottom buttons
|
||||
(pack (make <Button> :parent b :text "Dismiss"
|
||||
:command (lambda () (destroy t)))
|
||||
(make <Button> :parent b :text "See Code"
|
||||
:command (lambda () (show-code name)))
|
||||
:side "left"
|
||||
:expand #t)
|
||||
|
||||
;; If variables is not null, add a 'See variables' button
|
||||
(unless (null? variables)
|
||||
(pack (make <Button> :parent b :text "Show Variables"
|
||||
:command (lambda () (show-variables t variables)))
|
||||
:side "left"
|
||||
:expand #t))
|
||||
|
||||
(pack b :side "bottom" :expand #f :fill "x" :pady "2m")
|
||||
|
||||
;; return the middle frame
|
||||
f))
|
||||
|
||||
|
||||
;;;; show-code
|
||||
;;;; This procedure creates a toplevel window that displays the code for
|
||||
;;;; a demonstration and allows it to be edited and reinvoked.
|
||||
(define (show-code name)
|
||||
(define (show file)
|
||||
(if (file-exists? file)
|
||||
(let* ((top (make <Toplevel> :title (format #f "Demo code: ~A" file)
|
||||
:geometry "+400+400"))
|
||||
(but (make <Frame> :parent top))
|
||||
(txt (make <Scroll-Text> :parent top :wrap "none"
|
||||
:h-scroll-side "bottom" :width 85 :height 30 :font "fixed"
|
||||
:value (exec (string-append "cat " file)))))
|
||||
|
||||
(pack txt :side "top" :expand #t :fill "both")
|
||||
(pack but :side "bottom" :expand #f :fill "x")
|
||||
|
||||
(pack (make <Button> :text "Dismiss" :parent top
|
||||
:command (lambda() (destroy top)))
|
||||
(make <Button> :text "Rerun Demo" :parent top
|
||||
:command (lambda ()
|
||||
(eval-string
|
||||
(format #f "(begin ~A (demo-~A))"
|
||||
(slot-ref txt 'value)
|
||||
name))))
|
||||
:side "left"
|
||||
:expand #t)
|
||||
#t)
|
||||
#f))
|
||||
(let ((file (string-append "W" name ".stklos")))
|
||||
(unless (show (string-append *STk-library* "/../Demos/Widget/" file))
|
||||
(unless (show (string-append *STk-library* "/demos/" file))
|
||||
(error "Unable to show the code of the file ~S" file)))))
|
||||
|
||||
|
||||
;;;; show-variables
|
||||
;;;; Displays the values of one or more variables in a window, and
|
||||
;;;; updates the display whenever any of the variables changes.
|
||||
(define (show-variables parent vars)
|
||||
(unless (null? vars)
|
||||
(let ((top (make <Toplevel> :parent parent :title "Variable values")))
|
||||
|
||||
(pack (make <Label> :text "Variable values:"
|
||||
:width 20
|
||||
:parent top
|
||||
:anchor "center"
|
||||
:font "-Adobe-helvetica-medium-r-normal--*-180-*-*-*-*-*-*")
|
||||
:side "top"
|
||||
:fill "x")
|
||||
|
||||
;; For each variable create a trace.
|
||||
(for-each (lambda (x)
|
||||
(let ((f (make <Frame> :parent top)))
|
||||
(pack (make <Label> :parent f :text (format #f "~A = " x))
|
||||
:side "left")
|
||||
(pack (make <Label> :parent f :text-variable x :anchor "w")
|
||||
:side "left" :expand #t :fill "x")
|
||||
(pack f :side "top" :anchor "w" :fill "x")))
|
||||
vars)
|
||||
|
||||
;; Create a destroy button
|
||||
(pack (make <Button> :parent top :text "Dismiss"
|
||||
:command (lambda () (destroy top)))
|
||||
:side "bottom"
|
||||
:pady 2))))
|
||||
|
||||
;;;;--------------------------------------------------------------------------
|
||||
;;;;
|
||||
;;;; Create the main window widgets
|
||||
;;;;
|
||||
;;;;--------------------------------------------------------------------------
|
||||
|
||||
(slot-set! *top-root* 'title "Widget Demonstration")
|
||||
|
||||
(let* ((t (make <Scroll-Text> :wrap "word" :width 60 :height 30
|
||||
:font demo-font :set-grid #t))
|
||||
(quit (make <Button> :text "Quit" :command (lambda () (exit 0))))
|
||||
(title (make <Text-tag> :parent t
|
||||
:font "-*-Helvetica-Bold-R-Normal--*-180-*-*-*-*-*-*"))
|
||||
(demo (make <Text-tag> :parent t :lmargin1 "1c" :lmargin2 "1c"))
|
||||
(hot (apply make <Text-tag> :parent t
|
||||
(if (= (winfo 'depth *root*) 1)
|
||||
(list :background "black" :foreground "white")
|
||||
(list :relief "raised" :border-width 1
|
||||
:background "SeaGreen3"))))
|
||||
(last-line '()))
|
||||
|
||||
(pack t :expand #t :fill "both")
|
||||
(pack quit :expand #f :fill "x")
|
||||
|
||||
;; Associate binfings to tags
|
||||
(bind demo "<Button-1>"
|
||||
(lambda ()
|
||||
(invoke-demo-binding t (text-index t 'current))))
|
||||
|
||||
(bind demo "<Enter>"
|
||||
(lambda (x y)
|
||||
(set! last-line (text-index t (format #f "@~A,~A linestart" x y)))
|
||||
(tag-add hot last-line (cons (car last-line) "end"))))
|
||||
|
||||
(bind demo "<Leave>"
|
||||
(lambda ()
|
||||
(tag-remove hot '(1 . 0) "end")))
|
||||
|
||||
(bind demo "<Motion>"
|
||||
(lambda (x y)
|
||||
(let ((new-line (text-index t (format #f "@~A,~A linestart" x y))))
|
||||
(unless (equal? new-line last-line)
|
||||
(tag-remove hot '(1 . 0) "end")
|
||||
(tag-add hot new-line (cons (car new-line) "end"))
|
||||
(set! last-line new-line)))))
|
||||
|
||||
;; Create the text for the text widget.
|
||||
|
||||
(text-insert t "end"
|
||||
"Tk Widget Demonstrations\n\n" (list title)
|
||||
"This application provides a front end for several short scripts that demonstrate what you can do with Tk widgets. Each of the numbered lines below describes a demonstration; you can click on it to invoke the demonstration. Once the demonstration window appears, you can click the \"See Code\" button to see the Tcl/Tk code that created the demonstration. If you wish, you can edit the code and click the \"Rerun Demo\" button in the code window to reinvoke the demonstration with the modified code.\n" '()
|
||||
"\nLabels, buttons, checkbuttons, and radiobuttons\n" (list title)
|
||||
"1. Labels (text and bitmaps).\n" (list demo 'demo-label)
|
||||
"2. Buttons.\n" (list demo 'demo-button)
|
||||
"3. Checkbuttons (select any of a group).\n" (list demo 'demo-check)
|
||||
"4. Radiobuttons (select one of a group).\n" (list demo 'demo-radio)
|
||||
"5. A 15-puzzle game made out of buttons.\n" (list demo 'demo-puzzle)
|
||||
"6. Iconic buttons that use bitmaps.\n" (list demo 'demo-icon)
|
||||
"7. Two labels displaying images.\n" (list demo 'demo-image1)
|
||||
"8. A simple user interface for viewing images.\n" (list demo 'demo-image2)
|
||||
;;;;;;
|
||||
"\nListboxes\n" (list title)
|
||||
"1. 50 states.\n" (list demo 'demo-states)
|
||||
"2. Colors: change the color scheme for the application.\n"
|
||||
(list demo 'demo-colors)
|
||||
"3. A collection of famous sayings.\n" (list demo 'demo-sayings)
|
||||
;;;;;;
|
||||
"\nEntries\n" title
|
||||
"1. Without scrollbars.\n" (list demo 'demo-entry1)
|
||||
"2. With scrollbars.\n" (list demo 'demo-entry2)
|
||||
"3. Simple Rolodex-like form.\n" (list demo 'demo-form)
|
||||
;;;;;;
|
||||
"\nText\n" title
|
||||
"1. Basic editable text.\n" (list demo 'demo-text)
|
||||
"2. Text display styles.\n" (list demo 'demo-styles)
|
||||
"3. Hypertext (tag bindings).\n" (list demo 'demo-bind)
|
||||
"4. A text widget with embedded windows.\n" (list demo 'demo-wind)
|
||||
"5. A search tool built with a text widget.\n" (list demo 'demo-search)
|
||||
;;;;
|
||||
"\nCanvases\n" title
|
||||
"1. The canvas item types.\n" (list demo 'demo-items)
|
||||
"2. A simple 2-D plot.\n" (list demo 'demo-plot)
|
||||
"3. Text items in canvases.\n" (list demo 'demo-ctext)
|
||||
"4. An editor for arrowheads on canvas lines.\n" (list demo 'demo-arrow)
|
||||
"5. A ruler with adjustable tab stops.\n" (list demo 'demo-ruler)
|
||||
"6. A building floor plan.\n" (list demo 'demo-floor)
|
||||
"7. A simple scrollable canvas.\n" (list demo 'demo-cscroll)
|
||||
;;;;
|
||||
"\nScales\n" title
|
||||
"1. Vertical scale.\n" (list demo 'demo-vscale)
|
||||
"2. Horizontal scale.\n" (list demo 'demo-hscale)
|
||||
;;;;
|
||||
"\nMenus\n" title
|
||||
"1. A window containing several menus and cascades.\n"
|
||||
(list demo 'demo-menu)
|
||||
;;;;
|
||||
"\nMiscellaneous\n" title
|
||||
"1. The built-in bitmaps.\n" (list demo 'demo-bitmap)
|
||||
"2. A dialog box with a local grab.\n" (list demo 'demo-dialog1)
|
||||
"3. A dialog box with a global grab.\n" (list demo 'demo-dialog2)
|
||||
))
|
||||
|
||||
(define (invoke-demo-binding t index)
|
||||
(let loop ((t (text-tags t index)))
|
||||
(cond
|
||||
((null? t) #f)
|
||||
((string-find? "demo-" (car t)) (apply (eval (string->symbol (car t)))
|
||||
'()))
|
||||
(ELSE (loop (cdr t))))))
|
||||
|
||||
(define (NYI)
|
||||
(error "This demo is not yet implemented"))
|
||||
|
||||
;;
|
||||
;; Autolooads
|
||||
;;
|
||||
|
||||
(autoload "Wlabel" demo-label)
|
||||
(autoload "Wbutton" demo-button)
|
||||
(autoload "Wcheck" demo-check)
|
||||
(autoload "Wradio" demo-radio)
|
||||
(autoload "Wpuzzle" demo-puzzle)
|
||||
(autoload "Wicon" demo-icon)
|
||||
(autoload "Wimage1" demo-image1)
|
||||
(autoload "Wimage2" demo-image2)
|
||||
|
||||
(autoload "Wstates" demo-states)
|
||||
(autoload "Wcolors" demo-colors)
|
||||
(autoload "Wsayings" demo-sayings)
|
||||
|
||||
(autoload "Wentry1" demo-entry1)
|
||||
(autoload "Wentry2" demo-entry2)
|
||||
(autoload "Wform" demo-form)
|
||||
|
||||
(autoload "Wtext" demo-text)
|
||||
(autoload "Wstyles" demo-styles)
|
||||
(autoload "Wbind" demo-bind)
|
||||
(autoload "Wwind" demo-wind)
|
||||
(autoload "Wsearch" demo-search)
|
||||
|
||||
(autoload "Witems" demo-items)
|
||||
(autoload "Wplot" demo-plot)
|
||||
(autoload "Wctext" demo-ctext)
|
||||
(autoload "Warrow" demo-arrow)
|
||||
(define demo-ruler NYI)
|
||||
(define demo-floor NYI)
|
||||
(define demo-cscroll NYI)
|
||||
|
||||
(autoload "Wvscale" demo-vscale)
|
||||
(autoload "Whscale" demo-hscale)
|
||||
|
||||
(autoload "Wmenu" demo-menu)
|
||||
|
||||
(autoload "Wbitmap" demo-bitmap)
|
||||
(autoload "Wdialog1" demo-dialog1)
|
||||
(autoload "Wdialog2" demo-dialog2)
|
||||
|
|
@ -4,7 +4,7 @@
|
|||
;;;; a m i b . s t k l o s -- A mini interface builder. I hope it will serve
|
||||
;;;; as the basis of something more complete...
|
||||
;;;;
|
||||
;;;; Copyright © 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
;;;;
|
||||
;;;; Permission to use, copy, and/or distribute this software and its
|
||||
;;;; documentation for any purpose and without fee is hereby granted, provided
|
||||
|
|
@ -17,7 +17,7 @@
|
|||
;;;;
|
||||
;;;; Author: Erick Gallesio [eg@unice.fr]
|
||||
;;;; Creation date: 22-May-1995 14:56
|
||||
;;;; Last file update: 26-Sep-1996 19:21
|
||||
;;;; Last file update: 3-Mar-1998 22:50
|
||||
|
||||
(require "Tk-classes")
|
||||
|
||||
|
|
@ -26,10 +26,10 @@
|
|||
;;;; Definitions.
|
||||
;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define *amib-version* 0.3)
|
||||
(define *amib-version* 0.5)
|
||||
(define *pretty-names* (make-hash-table))
|
||||
(define *current-file* #f)
|
||||
(define *special-slots* '("id" "eid" "parent"))
|
||||
(define *special-slots* '("id" "eid" "parent" "environment"))
|
||||
(define *delay* 100)
|
||||
;;;;
|
||||
;;;; All the widgets and their defaults
|
||||
|
|
@ -70,21 +70,22 @@
|
|||
'break))
|
||||
|
||||
(define (make-drag-n-drop-widget type initargs)
|
||||
(let ((m (make <Menu> :border-width 12 :background "Blue")))
|
||||
(let ((m (make <Toplevel> :background "Blue" :override-redirect #t)))
|
||||
(pack (apply make type :parent m initargs) :padx 2 :pady 2)
|
||||
m))
|
||||
|
||||
(define (Drag-n-Drop-Motion)
|
||||
(when d-n-d-widget
|
||||
(apply menu-post d-n-d-widget (winfo 'pointerxy d-n-d-widget))
|
||||
(after *delay* (lambda () (Drag-n-Drop-Motion)))))
|
||||
(slot-set! d-n-d-widget 'geometry
|
||||
(apply format #f "+~A+~A" (winfo 'pointerxy d-n-d-widget)))
|
||||
(after *delay* (lambda () (Drag-n-Drop-Motion)))))
|
||||
|
||||
(define (Drag-n-Drop-Finish X Y)
|
||||
(when d-n-d-widget
|
||||
(let ((dwidth (winfo 'width d-n-d-widget))
|
||||
(dheight (winfo 'height d-n-d-widget)))
|
||||
;; Unpost the d-n-d-widget to see on which window we depose it
|
||||
(menu-unpost d-n-d-widget)
|
||||
;; iconify the d-n-d-widget and see on which window we depose it
|
||||
(withdraw d-n-d-widget)
|
||||
|
||||
(let* ((p (Id->instance (winfo 'containing X Y)))
|
||||
(top (Id->instance (winfo 'toplevel p))))
|
||||
|
|
@ -113,8 +114,6 @@
|
|||
(destroy d-n-d-widget)
|
||||
(set! d-n-d-widget #f)))
|
||||
|
||||
|
||||
|
||||
(define (create-new-widget lb x y Xabs Yabs)
|
||||
(unless d-n-d-widget
|
||||
(let* ((index (nearest lb y))
|
||||
|
|
@ -123,7 +122,7 @@
|
|||
(when search
|
||||
;; Create a drag and drow window and post it under the mouse
|
||||
(let ((W (apply make-drag-n-drop-widget (cadr search) (cddr search))))
|
||||
(menu-post W Xabs Yabs)
|
||||
(set! (geometry W) (format #f "+~a+~a" Xabs Yabs))
|
||||
(bindtags W (cons "Dnd" (bindtags W)))
|
||||
(set! d-n-d-widget W)
|
||||
(set! d-n-d-defaults (cdr search))
|
||||
|
|
@ -142,7 +141,7 @@
|
|||
:class "Amib-toplevel"
|
||||
:geometry (format #f "450x300+~A+~A" n n))))
|
||||
(set! count (+ count 1))
|
||||
(pack (make <Frame> :parent t) :expand #t :fill "both")))))
|
||||
(pack (make <Frame> :parent t :border-width 0) :expand #t :fill "both")))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;
|
||||
|
|
@ -482,12 +481,11 @@
|
|||
;;;; Code generation
|
||||
;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (Pretty-name w)
|
||||
(let ((name (hash-table-get *pretty-names* w #f)))
|
||||
(unless name
|
||||
;; If this object has no name, a name is generated for it
|
||||
(set! name (if (eqv? w *root*) "*root*" (gensym "W")))
|
||||
(set! name (if (eqv? w *top-root*) "*top-root*" (gensym "W")))
|
||||
(hash-table-put! *pretty-names* w name))
|
||||
name))
|
||||
|
||||
|
|
@ -500,7 +498,6 @@
|
|||
(use-pack? (null? infos)))
|
||||
(if use-pack?
|
||||
(set! infos (pack 'info w)))
|
||||
|
||||
(format #t "(~A ~A " (if use-pack? "pack " "place") (pretty-name w))
|
||||
|
||||
;; Display informations returned by Tk
|
||||
|
|
@ -519,20 +516,19 @@
|
|||
(loop (cddr i)))))))
|
||||
|
||||
(define-method generate-placement ((w <Toplevel>))
|
||||
(format #f ";; End of Toplevel ~A\n\n" (pretty-name w)))
|
||||
#f)
|
||||
|
||||
;;;;
|
||||
;;;; Generate-code-for-widget methods
|
||||
;;;;
|
||||
(define-method generate-code-for-widget ((w <Toplevel>))
|
||||
(format #t "\n;; Start of Toplevel ~A\n" (pretty-name w))
|
||||
(format #t "\n;; Definition of Toplevel ~A\n" (pretty-name w))
|
||||
(next-method))
|
||||
|
||||
(define-method generate-code-for-widget ((w <Tk-widget>))
|
||||
;; Generate name
|
||||
(format #t ";-----------\n(define ~A (make ~A\n\t:parent ~A\n"
|
||||
(pretty-name w) (class-name (class-of w)) (pretty-name (parent w)))
|
||||
|
||||
;; Generate non special slots
|
||||
(for-each (lambda (slot)
|
||||
(unless (member slot *special-slots*)
|
||||
|
|
@ -547,12 +543,10 @@
|
|||
(class-slots (class-of w)))
|
||||
;; Close parenthesis
|
||||
(format #t "))\n\n")
|
||||
|
||||
;; Generate code for embedded widgets. Don't do this if w is a composite
|
||||
(unless (is-a? w <Tk-composite-widget>)
|
||||
(for-each generate-code-for-widget
|
||||
(map Id->instance (winfo 'children w))))
|
||||
|
||||
;; Generate placement for this widget
|
||||
(generate-placement w))
|
||||
|
||||
|
|
@ -560,14 +554,19 @@
|
|||
;;;; Generate-code (the entry point of code generation)
|
||||
;;;;
|
||||
(define (generate-code file)
|
||||
(with-output-to-file file
|
||||
(lambda ()
|
||||
(format #t ";;\n;; Code generated by Amib (v~A)\n;;\n" *amib-version*)
|
||||
(for-each (lambda (x)
|
||||
(when (and (is-a? x <Toplevel>)
|
||||
(not (equal? (slot-ref x 'class) "Amib")))
|
||||
(generate-code-for-widget x)))
|
||||
(map Id->instance (winfo 'children *root*))))))
|
||||
(let ((all-tops (map Id->instance (winfo 'children *root*))))
|
||||
(letrec ((dump(lambda (func)
|
||||
(for-each (lambda (x)
|
||||
(when (and (is-a? x <Toplevel>)
|
||||
(not (equal?(slot-ref x 'class) "Amib")))
|
||||
(func x)))
|
||||
all-tops))))
|
||||
(with-output-to-file file
|
||||
(lambda ()
|
||||
(format #t ";;\n;; Code generated by Amib (v~A)\n;;\n" *amib-version*)
|
||||
(format #t "(require \"Tk-classes\")")
|
||||
(dump generate-code-for-widget)
|
||||
(dump generate-placement))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;
|
||||
|
|
@ -581,11 +580,11 @@
|
|||
(write-file)))
|
||||
|
||||
(define (load-file)
|
||||
(let ((f (make-file-box)))
|
||||
(let ((f (Tk:get-open-file)))
|
||||
(when f (load f))))
|
||||
|
||||
(define (write-file)
|
||||
(let ((f (make-file-box)))
|
||||
(let ((f (Tk:get-save-file)))
|
||||
(when f
|
||||
(set! *current-file* f)
|
||||
(generate-code f))))
|
||||
|
|
|
|||
|
|
@ -8,10 +8,11 @@
|
|||
;;;; double-clicking.
|
||||
;;;; This is a new version of the demo which can be run before STk is installed
|
||||
;;;;
|
||||
;;;; $Id: browse.stk 1.2 Mon, 16 Feb 1998 08:28:39 +0100 eg $
|
||||
;;;;
|
||||
;;;; Author: Erick Gallesio [eg@unice.fr]
|
||||
;;;; Creation date: 3-Aug-1993 17:33
|
||||
;;;; Last file update: 18-Sep-1995 14:25
|
||||
;;;; Last file update: 12-Feb-1998 11:28
|
||||
|
||||
(require "unix")
|
||||
|
||||
|
|
|
|||
|
|
@ -7,10 +7,11 @@
|
|||
;;;; directory and allows you to open files or subdirectories by
|
||||
;;;; double-clicking.
|
||||
;;;;
|
||||
;;;; $Id: browse.stklos 1.2 Mon, 16 Feb 1998 08:28:39 +0100 eg $
|
||||
;;;;
|
||||
;;;; Author: Erick Gallesio [eg@unice.fr]
|
||||
;;;; Creation date: 3-Aug-1993 17:33
|
||||
;;;; Last file update: 18-Sep-1995 14:25
|
||||
;;;; Last file update: 12-Feb-1998 11:28
|
||||
|
||||
(require "Tk-classes")
|
||||
(require "unix")
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
;;;;
|
||||
;;;; c a l c . s t k l o s -- A very simplistic calculator
|
||||
;;;;
|
||||
;;;; Copyright © 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
;;;;
|
||||
;;;; Permission to use, copy, and/or distribute this software and its
|
||||
;;;; documentation for any purpose and without fee is hereby granted, provided
|
||||
|
|
@ -13,9 +13,11 @@
|
|||
;;;; permission of the copyright holder.
|
||||
;;;; This software is provided ``as is'' without express or implied warranty.
|
||||
;;;;
|
||||
;;;; $Id: calc.stklos 1.2 Mon, 16 Feb 1998 08:28:39 +0100 eg $
|
||||
;;;;
|
||||
;;;; Author: Erick Gallesio [eg@unice.fr]
|
||||
;;;; Creation date: 6-Apr-1995 18:11
|
||||
;;;; Last file update: 18-Sep-1995 14:25
|
||||
;;;; Last file update: 12-Feb-1998 11:28
|
||||
|
||||
(require "Tk-classes")
|
||||
(define Result 0)
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#!/bin/sh
|
||||
:;exec /usr/local/bin/stk -f "$0" "$@"
|
||||
;;;;
|
||||
;;;; Copyright © 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
;;;;
|
||||
;;;; Permission to use, copy, and/or distribute this software and its
|
||||
;;;; documentation for any purpose and without fee is hereby granted, provided
|
||||
|
|
@ -13,7 +13,7 @@
|
|||
;;;;
|
||||
;;;; Author: Erick Gallesio [eg@unice.fr]
|
||||
;;;; Creation date: 19-Aug-1993 15:08
|
||||
;;;; Last file update: 21-Jul-1996 11:24
|
||||
;;;; Last file update: 24-Feb-1998 11:50
|
||||
|
||||
(define Color "#000000")
|
||||
(define V (vector 0 0 0))
|
||||
|
|
@ -29,7 +29,7 @@
|
|||
|
||||
(frame f :relief "groove" :bd 2)
|
||||
(pack
|
||||
[label (format #f "~a.l" f) :text name :width 10]
|
||||
[label (format #f "~a.l" f) :text name :foreground name :width 10]
|
||||
[scale (format #f "~a.s" f) :from 0 :to 255 :orient "horiz"
|
||||
:command cmd :length 300]
|
||||
:side "left" :padx 2 :pady 2)
|
||||
|
|
|
|||
|
|
@ -1,133 +0,0 @@
|
|||
#!/bin/sh
|
||||
:;exec /usr/local/bin/stk -f "$0" "$@"
|
||||
;;
|
||||
;; A quick demo of the composite widgets
|
||||
;; This code is a contribution of Drew.Whitehouse@anu.edu.au
|
||||
;;
|
||||
;; Multiple-window added by eg on 96/04/14
|
||||
|
||||
(require "Tk-classes")
|
||||
|
||||
(define main-frame (make <Frame>))
|
||||
(define title (make <Label> :parent main-frame :text "Composite Widgets Demo"))
|
||||
(define button-box (make <Frame> :parent main-frame :width 200 :height 100))
|
||||
(define quit (make <Button> :parent main-frame
|
||||
:text " quit "
|
||||
:command (lambda ()
|
||||
(destroy *root*))))
|
||||
|
||||
(define composite-widgets '(Choicebox
|
||||
Defbutton
|
||||
Filebox
|
||||
Lentry
|
||||
Paned
|
||||
Scrollbox
|
||||
Multiwin))
|
||||
(for-each (lambda (x)
|
||||
(let ((cmd (string-append "(demo-" (symbol->string x) ")")))
|
||||
(pack (make <Button> :parent button-box :text x :command cmd)
|
||||
:fill 'x :padx 5 )))
|
||||
composite-widgets)
|
||||
|
||||
(pack title button-box :fill 'x :padx 10 :pady 10)
|
||||
(pack quit :padx 10 :pady 10 )
|
||||
(pack main-frame)
|
||||
|
||||
(define (demo-choicebox)
|
||||
(let* ((tl (make <Toplevel> :title "Choice Box"))
|
||||
(cb (make <Choice-box> :value "empty for now!" :parent tl)))
|
||||
;; add some entries
|
||||
(for-each (lambda (x) (add-choice cb (symbol->string x)))
|
||||
composite-widgets)
|
||||
(pack cb)))
|
||||
|
||||
(define (demo-defbutton)
|
||||
(pack (make <Default-button>
|
||||
:text "button"
|
||||
:width 20
|
||||
:parent (make <Toplevel> :title "Default Button"))))
|
||||
|
||||
(define (demo-filebox)
|
||||
(let ((f (make-file-box)))
|
||||
(if f
|
||||
(format #t "You have selected ~S\n" f)
|
||||
(format #t "Cancel\n"))))
|
||||
|
||||
(define (demo-lentry)
|
||||
(pack (make <Labeled-entry>
|
||||
:title "title"
|
||||
:parent (make <Toplevel> :title "Labeled entry"))
|
||||
:padx 5 :pady 5))
|
||||
|
||||
(define (demo-paned)
|
||||
(let* ((tl (make <Toplevel> :title "Paned demo"))
|
||||
(hp (make <HPaned> :fraction 0.3 :width 300 :height 300 :parent tl))
|
||||
(f1 (make <Label> :text "top pane" :parent (top-frame-of hp)))
|
||||
(f2 (make <Label> :text "bottom-pane" :parent (bottom-frame-of hp)))
|
||||
(vp (make <VPaned> :fraction 0.3 :width 300 :height 300 :parent tl))
|
||||
(f3 (make <Label> :text "left pane" :parent (left-frame-of vp)))
|
||||
(f4 (make <Label> :text "right-pane" :parent (right-frame-of vp))))
|
||||
(pack f1 f2 f3 f4 :expand #t)
|
||||
(pack hp vp)))
|
||||
|
||||
(define (demo-scrollbox)
|
||||
(let* ((tl (make <Toplevel> :title "Scroll box"))
|
||||
(sb (make <Scroll-listbox> :parent tl :geometry "20x6")))
|
||||
;; add some entries into the listbox
|
||||
(for-each (lambda (x)
|
||||
(insert (listbox-of sb) 0 x))
|
||||
(append composite-widgets composite-widgets))
|
||||
(pack sb)))
|
||||
|
||||
|
||||
(define (demo-multiwin)
|
||||
;;
|
||||
;; Make a Menu bar
|
||||
;;
|
||||
(define tl (make <Toplevel> :title "Multiple and Inner windows demo"))
|
||||
(define top (make <Frame> :parent tl))
|
||||
(define col '#("violet" "skyblue1" "Misty Rose" "Plum" "grey40"))
|
||||
(define menu (make-menubar top
|
||||
`(("Menu"
|
||||
("Add one" ,(let ((counter 0))
|
||||
(lambda ()
|
||||
(place (make <Inner-window> :parent f
|
||||
:title (format #f "Window #~A" counter)
|
||||
:background (vector-ref col (random 5)))
|
||||
:x (random 200) :y (random 200))
|
||||
(set! counter (1+ counter)))))
|
||||
("")
|
||||
("Quit" ,(lambda () (destroy tl)))))))
|
||||
(pack menu :side "left" :expand #f)
|
||||
(pack top :fill "x")
|
||||
;;
|
||||
;; Make a multiple window
|
||||
;;
|
||||
(define f (make <Multiple-window> :parent tl :background "cyan4"))
|
||||
(pack f :fill "both" :expand #t)
|
||||
|
||||
;;
|
||||
;; First child
|
||||
;;
|
||||
(define f1 (make <Inner-window> :parent f :title "A Text window"))
|
||||
(define t1 (make <Scroll-Text> :highlight-thickness 0 :parent f1 :height 8
|
||||
:background "lightblue3" :wrap "word"
|
||||
:value "Hi!I'm a text window\n\n\n\n\n\n\n\n\n\n\n\n\n\n\nEnd"))
|
||||
(define t2 (make <Scroll-Text> :highlight-thickness 0 :parent f1
|
||||
:background "lightblue3" :wrap "word"
|
||||
:value "Hi, I'm also embedded in a window.\nUse the mouse in the border of my enclosing window to enlarge or shrink this editor"))
|
||||
(pack t1 t2 :fill "both" :expand #t)
|
||||
(place f1 :x 100 :y 70)
|
||||
|
||||
;;
|
||||
;; Second child
|
||||
;;
|
||||
(define f2 (make <Inner-window> :parent f :title "A canvas window"))
|
||||
(define c1 (make <Canvas> :parent f2 :background "#c4b6a7"))
|
||||
(make <Rectangle> :parent c1 :fill "IndianRed1" :coords '(0 0 50 50))
|
||||
(make <Oval> :parent c1 :fill "DarkOliveGreen" :coords '(100 100 150 150))
|
||||
(bind-for-dragging c1)
|
||||
(pack c1 :fill "both" :expand #t)
|
||||
(place f2 :x 10 :y 10))
|
||||
|
||||
|
||||
|
|
@ -1,7 +1,9 @@
|
|||
#!/usr/local/bin/stk -f
|
||||
#!/bin/sh
|
||||
:;exec /usr/local/bin/stk -f "$0" "$@"
|
||||
;;;;
|
||||
;;;; f i l e b o x . s t k l o s -- A demo of the <FileBox> class
|
||||
;;;;
|
||||
;;;; Copyright © 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
;;;;
|
||||
;;;; Permission to use, copy, and/or distribute this software and its
|
||||
;;;; documentation for any purpose and without fee is hereby granted, provided
|
||||
|
|
@ -14,24 +16,20 @@
|
|||
;;;; This software is a derivative work of other copyrighted softwares; the
|
||||
;;;; copyright notices of these softwares are placed in the file COPYRIGHTS
|
||||
;;;;
|
||||
;;;; $Id: filebox.stklos 1.2 Mon, 16 Feb 1998 08:28:39 +0100 eg $
|
||||
;;;;
|
||||
;;;; Author: Erick Gallesio [eg@kaolin.unice.fr]
|
||||
;;;; Creation date: 12-Jun-1994 11:24
|
||||
;;;; Last file update: 22-Aug-1996 18:14
|
||||
;;;; Last file update: 12-Feb-1998 11:27
|
||||
|
||||
(require "Tk-classes")
|
||||
|
||||
(define b (make <Button> :text "Quit the demo" :foreground "red"
|
||||
:command (lambda () (exit))))
|
||||
(pack b)
|
||||
|
||||
|
||||
;;; Just create a filebox and return the selected value
|
||||
(let loop ((result (make-file-box)))
|
||||
;; Just create a filebox and return the selected value
|
||||
(let ((result (Tk:get-file)))
|
||||
(apply format #t (if result
|
||||
(list "You have selected the file ~S\n" result)
|
||||
(list "CANCEL. No file selected\n")))
|
||||
(loop (make-file-box)))
|
||||
|
||||
(exit 0))
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,109 +0,0 @@
|
|||
#!/bin/sh
|
||||
:;exec /usr/local/bin/stk -f "$0" "$@"
|
||||
;;;;
|
||||
;;;; h b r o w s e -- A HTML browser
|
||||
;;;;
|
||||
;;;; Copyright © 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
;;;;
|
||||
;;;; Permission to use, copy, and/or distribute this software and its
|
||||
;;;; documentation for any purpose and without fee is hereby granted, provided
|
||||
;;;; that both the above copyright notice and this permission notice appear in
|
||||
;;;; all copies and derived works. Fees for distribution or use of this
|
||||
;;;; software or derived works may only be charged with express written
|
||||
;;;; permission of the copyright holder.
|
||||
;;;; This software is provided ``as is'' without express or implied warranty.
|
||||
;;;;
|
||||
;;;; Author: Erick Gallesio [eg@unice.fr]
|
||||
;;;; Creation date: 31-Aug-1995 15:15
|
||||
;;;; Last file update: 17-Sep-1996 11:49
|
||||
;;;;
|
||||
|
||||
(require "Tk-classes")
|
||||
(require "Basics")
|
||||
(require "html")
|
||||
|
||||
(expand-heap 100000) ; but far lower than netscape ;-)
|
||||
|
||||
;;;
|
||||
;;; <Gauge> class definition
|
||||
;;;
|
||||
;;; I don't use the <Canvas> class to avoid its (long) loading.
|
||||
;;; Only a little bit of canvas capabilities are used here
|
||||
|
||||
(define-class <Gauge> (<Tk-simple-widget> <Tk-sizeable>)
|
||||
((foreground :accessor foreground :initform "red" :init-keyword :foreground)))
|
||||
|
||||
(define-method tk-constructor ((self <Gauge>))
|
||||
Tk:canvas)
|
||||
|
||||
(define-method initialize ((self <Gauge>) initargs)
|
||||
(next-method)
|
||||
(slot-set! self 'highlight-thickness 0)
|
||||
((slot-ref self 'Id) 'create 'line 0 0 0 0
|
||||
:fill (foreground self)
|
||||
:width (* 2 (+ (height self) 2))))
|
||||
|
||||
(define (update-gauge g percent)
|
||||
((slot-ref g 'Id) 'coords "1" 0 0 (quotient (* (width g) percent) 100) 0)
|
||||
(update))
|
||||
|
||||
;;;
|
||||
;;; Make interface
|
||||
;;;
|
||||
(let ((loc (make <Labeled-entry>
|
||||
:title "Location:"
|
||||
:text-variable '*location*
|
||||
:font "fixed"))
|
||||
(txt (make <Scroll-text>
|
||||
:font "fixed"
|
||||
:width 80
|
||||
:height 45)))
|
||||
|
||||
(bind (Id loc) "<Return>" (lambda () (Html:view-url (Id txt) (value loc))))
|
||||
(pack loc :expand #f :fill "x" :padx 30 :pady 4)
|
||||
(pack txt :expand #t :fill "both")
|
||||
|
||||
(let* ((f (make <Frame>))
|
||||
(lab (make <Label> :parent f :anchor "w"))
|
||||
(gauge (make <Gauge> :width 200 :height 10 :background "blue")))
|
||||
(pack lab :padx 30 :pady 4 :side "left")
|
||||
(pack gauge :padx 10 :side "right")
|
||||
(pack f :fill "x")
|
||||
|
||||
;; See if a file was specified
|
||||
(when (> *argc* 0)
|
||||
(set! *location* (car *argv*))
|
||||
(Html:view-url (Id txt) *location*))
|
||||
|
||||
;; Initialize hooks
|
||||
(let ((counter 0)
|
||||
(pos 0))
|
||||
(set! html:hook-formatting
|
||||
(lambda ()
|
||||
(when (= counter 20)
|
||||
(set! pos (modulo (+ pos 5) 105))
|
||||
(set! counter 0)
|
||||
(update-gauge gauge pos))
|
||||
(set! counter (+ counter 1))))
|
||||
|
||||
(set! html:hook-start-loading
|
||||
(lambda ()
|
||||
(slot-set! txt 'cursor "watch")
|
||||
(slot-set! lab 'text "Loading Document ...")
|
||||
(update)))
|
||||
|
||||
(set! html:hook-stop-loading
|
||||
(lambda ()
|
||||
(update-gauge gauge 0)
|
||||
(slot-set! lab 'text "Document done.")
|
||||
(slot-set! txt 'cursor "top_left_arrow")
|
||||
(after 5000 (lambda () (slot-set! lab 'text "")))))
|
||||
|
||||
(set! html:hook-title
|
||||
(lambda (value)
|
||||
(slot-set! *top-root* 'title value)))
|
||||
|
||||
(set! html:hook-location
|
||||
(lambda (value)
|
||||
(set! *location* value))))))
|
||||
|
||||
|
|
@ -3,7 +3,7 @@
|
|||
;;;; m c - s e r v e r . s t k -- A simple server which accept
|
||||
;;;; multiple client connections
|
||||
;;;;
|
||||
;;;; Copyright © 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
;;;; Copyright © 1993-1997 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
;;;;
|
||||
;;;; Permission to use, copy, and/or distribute this software and its
|
||||
;;;; documentation for any purpose and without fee is hereby granted, provided
|
||||
|
|
@ -18,7 +18,7 @@
|
|||
;;;;
|
||||
;;;; Author: Erick Gallesio [eg@kaolin.unice.fr]
|
||||
;;;; Creation date: 23-Jul-1996 09:00
|
||||
;;;; Last file update: 23-Jul-1996 10:09
|
||||
;;;; Last file update: 11-Oct-1997 10:14
|
||||
|
||||
(require "posix")
|
||||
(require "socket")
|
||||
|
|
@ -30,7 +30,7 @@
|
|||
;; Accept connection
|
||||
(socket-accept-connection s)
|
||||
|
||||
;; Save socket somewher to avoid GC problems
|
||||
;; Save socket somewhere to avoid GC problems
|
||||
(set! sockets (cons s sockets))
|
||||
|
||||
(let ((in (socket-input s))
|
||||
|
|
@ -48,13 +48,14 @@
|
|||
;; Create a handler for reading inputs from this new connection
|
||||
(when-port-readable in
|
||||
(lambda ()
|
||||
;; And read all the lines comming from distant machine
|
||||
;; And read all the lines coming from distant machine
|
||||
(let ((l (read-line in)))
|
||||
(if (eof-object? l)
|
||||
;; delete current handler
|
||||
(begin
|
||||
(when-port-readable in #f)
|
||||
(socket-shutdown s))
|
||||
(socket-shutdown s)
|
||||
(set! sockets (remove s sockets)))
|
||||
;; Just write the line read on the socket
|
||||
(begin
|
||||
(format out "On connection #~S I've read --> ~A\n" cnt l)
|
||||
|
|
|
|||
|
|
@ -24,7 +24,7 @@
|
|||
|
||||
|
||||
|
||||
(define queen-bitmap (string-append "@" *STk-library* "/images/queen"))
|
||||
(define queen-bitmap (string-append "@" *STk-library* "/Images/queen"))
|
||||
|
||||
; size of board (it's square)
|
||||
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@
|
|||
;;
|
||||
;; Author: Erick Gallesio [eg@unice.fr]
|
||||
;; Creation date: 9-Aug-1993 22:06
|
||||
;; Last file update: 17-Jan-1996 16:54
|
||||
;; Last file update: 2-Mar-1998 00:25
|
||||
|
||||
(define (show-vars w . args)
|
||||
(catch (destroy w))
|
||||
|
|
@ -40,8 +40,7 @@
|
|||
(pack w.i :side "top" :anchor "w")))
|
||||
args)
|
||||
|
||||
(pack [button (& w ".ok") :text " OK " :command (lambda ()
|
||||
(destroy w))]
|
||||
(pack [button (& w ".ok") :text "Quit" :command (lambda () (exit 0))]
|
||||
:side "bottom"
|
||||
:pady 2))
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
;;;;
|
||||
;;;; s t k l o s - d e m o . s t k -- A demo which use some STklos classes
|
||||
;;;;
|
||||
;;;; Copyright © 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
;;;;
|
||||
;;;; Permission to use, copy, and/or distribute this software and its
|
||||
;;;; documentation for any purpose and without fee is hereby granted, provided
|
||||
|
|
@ -14,7 +14,7 @@
|
|||
;;;;
|
||||
;;;; Author: Erick Gallesio [eg@unice.fr]
|
||||
;;;; Creation date: 24-Aug-1993 19:55
|
||||
;;;; Last file update: 21-Jul-1996 11:32
|
||||
;;;; Last file update: 3-Mar-1998 17:18
|
||||
|
||||
(require "Tk-classes")
|
||||
|
||||
|
|
@ -30,10 +30,11 @@
|
|||
(define f (make <Frame>))
|
||||
(define l (make <Label> :parent f :text "A simple demo written in STklos"))
|
||||
(define c (make <Canvas> :parent f :relief "groove" :height 400 :width 700))
|
||||
(define m (make <Label> :parent f :font "fixed"
|
||||
(define m (make <Label> :parent f :font "fixed" :justify 'left
|
||||
:foreground "red"
|
||||
:text "Left button to move squares. Right button to move circles"))
|
||||
(define q (make <Button> :text "Quit" :command '(exit)))
|
||||
:text "Left button to move squares.
|
||||
Right button to move circles"))
|
||||
(define q (make <Button> :text "Quit" :command (lambda () (exit 0))))
|
||||
|
||||
(pack l c m q :in f :expand #t :fill 'both)
|
||||
(pack f)
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
;;;;
|
||||
;;;; s t k l o s - d e m o 2 . s t k -- A demo which use some STklos classes
|
||||
;;;;
|
||||
;;;; Copyright © 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
;;;;
|
||||
;;;; Permission to use, copy, and/or distribute this software and its
|
||||
;;;; documentation for any purpose and without fee is hereby granted, provided
|
||||
|
|
@ -14,23 +14,26 @@
|
|||
;;;;
|
||||
;;;; Author: Erick Gallesio [eg@unice.fr]
|
||||
;;;; Creation date: 24-Aug-1993 19:55
|
||||
;;;; Last file update: 21-Jul-1996 11:44
|
||||
;;;; Last file update: 3-Mar-1998 17:21
|
||||
|
||||
(require "Tk-classes")
|
||||
|
||||
(format #t "
|
||||
This demo file illustrates the use of bind-for-dragging with various
|
||||
parameters.
|
||||
;;;; Make canvas
|
||||
(define f (make <Frame>))
|
||||
(define l (make <Label> :parent f :text "A simple demo written in STklos"))
|
||||
(define c (make <Canvas> :parent f :relief "groove" :height 400 :width 700))
|
||||
(define m (make <Label> :parent f :font "fixed" :justify 'left
|
||||
:text "This demo file illustrates the use of bind-for-dragging with various parameters:
|
||||
- Left button to drag any kind of object.
|
||||
- Left button with Shift key pressed to drag an object and executes user hooks
|
||||
- Right button to move red objects only."))
|
||||
|
||||
Left button to drag any kind of object
|
||||
Left button with Shift key pressed to drag an object and executes user hooks
|
||||
Right button to move red objects only.\n")
|
||||
|
||||
|
||||
(define c (make <Canvas> :border-width 0))
|
||||
(pack c)
|
||||
(define q (make <Button> :text "Quit" :command (lambda () (exit 0))))
|
||||
|
||||
(pack l c m q :in f :expand #t :fill 'both)
|
||||
(pack f)
|
||||
|
||||
;;;; Make items
|
||||
(define r1 (make <rectangle> :coords '(0 0 50 50)
|
||||
:parent c
|
||||
:fill "red"
|
||||
|
|
@ -56,4 +59,3 @@ Right button to move red objects only.\n")
|
|||
|
||||
;; Button 3 for dragging red objects (i.e. r1 and t)
|
||||
(bind-for-dragging c :tag "red" :button 3)
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,219 @@
|
|||
#!/bin/sh
|
||||
:;exec /usr/local/bin/stk -f "$0" "$@"
|
||||
;;
|
||||
;; A quick demo of the STklos widgets
|
||||
;; This code is a contribution of Drew.Whitehouse@anu.edu.au
|
||||
;;
|
||||
;; Multiple-window added by eg on 96/04/14
|
||||
;; Gauges and help balloon added by eg on 96/10/23
|
||||
|
||||
(require "Tk-classes")
|
||||
|
||||
(define main-frame (make <Frame>))
|
||||
(define title (make <Label> :parent main-frame :text "STklos Widgets Demo"))
|
||||
(define button-box (make <Frame> :parent main-frame :width 200 :height 100))
|
||||
(define quit (make <Button> :parent main-frame
|
||||
:text " quit "
|
||||
:command (lambda ()
|
||||
(destroy *root*))))
|
||||
|
||||
(define composite-widgets '(Choice-box
|
||||
Color-Box
|
||||
Default-button
|
||||
File-box
|
||||
Gauge
|
||||
Help-Balloon
|
||||
Labeled-Entry
|
||||
Labeled-Frame
|
||||
Multiple-Window
|
||||
Paned
|
||||
Scroll-Canvas
|
||||
Scroll-Listbox
|
||||
Scroll-text
|
||||
Valued-Gauge))
|
||||
|
||||
(for-each (lambda (x)
|
||||
(let ((cmd (string-append "(demo-" (symbol->string x) ")")))
|
||||
(pack (make <Button> :parent button-box :text x :command cmd)
|
||||
:fill 'x :padx 5 )))
|
||||
composite-widgets)
|
||||
|
||||
(pack title button-box :fill 'x :padx 10 :pady 10)
|
||||
(pack quit :padx 10 :pady 10 )
|
||||
(pack main-frame)
|
||||
|
||||
;=============================================================================
|
||||
(define (demo-choice-box)
|
||||
(let* ((tl (make <Toplevel> :title "Choice Box"))
|
||||
(cb (make <Choice-box> :value "empty for now!" :parent tl)))
|
||||
;; add some entries
|
||||
(for-each (lambda (x) (add-choice cb (symbol->string x)))
|
||||
composite-widgets)
|
||||
(pack cb)))
|
||||
|
||||
;=============================================================================
|
||||
(define (demo-color-box)
|
||||
(let ((f (make <Color-Box> :value "gray75")))
|
||||
(colorbox-wait-result f)))
|
||||
|
||||
;=============================================================================
|
||||
(define (demo-default-button)
|
||||
(pack (make <Default-button>
|
||||
:text "button"
|
||||
:width 20
|
||||
:parent (make <Toplevel> :title "Default Button"))))
|
||||
|
||||
;=============================================================================
|
||||
(define (demo-file-box)
|
||||
(let ((f (make-file-box)))
|
||||
(if f
|
||||
(format #t "You have selected ~S\n" f)
|
||||
(format #t "Cancel\n"))))
|
||||
|
||||
;=============================================================================
|
||||
(define (demo-gauge)
|
||||
(let* ((top (make <Toplevel> :title "Gauge widget"))
|
||||
(g (make <Gauge> :parent top :width 400 :height 15
|
||||
:foreground "IndianRed4")))
|
||||
(pack g :expand #t :fill "both")
|
||||
(dotimes (i 101)
|
||||
(slot-set! g 'value i)
|
||||
(after 5)
|
||||
(update))))
|
||||
|
||||
;=============================================================================
|
||||
(define (demo-help-balloon)
|
||||
(let* ((top (make <Toplevel> :title "Balloon Help"))
|
||||
(f (make <Frame> :parent top))
|
||||
(txt (make <Label> :parent top
|
||||
:text "Place the mouse on a button\n and wait a while"))
|
||||
(h (make <Help-Balloon>)))
|
||||
(for-each (lambda (x)
|
||||
(let ((b (make <Button> :parent f :text x :side "left")))
|
||||
(add-balloon h b (format #f "This is ~S" x))
|
||||
(pack b :side "left")))
|
||||
'("Button1" "Button2" "Button3" "Button4" "Button5" "Button6"))
|
||||
(pack f )
|
||||
(pack txt :expand #t :fill "both")))
|
||||
|
||||
;=============================================================================
|
||||
(define (demo-labeled-entry)
|
||||
(pack (make <Labeled-entry>
|
||||
:title "Enter your name"
|
||||
:parent (make <Toplevel> :title "Labeled entry"))
|
||||
:padx 5 :pady 5))
|
||||
|
||||
;=============================================================================
|
||||
(define (demo-labeled-frame)
|
||||
(define top (make <Toplevel> :title "Labeld Frames"))
|
||||
(define lf (make <Labeled-Frame> :title "Font" :parent top))
|
||||
(pack lf :fill "both" :expand #t :side "left")
|
||||
|
||||
(for-each (lambda (x)
|
||||
(pack (make <Radio-button> :anchor "w" :parent lf :variable 'font
|
||||
:text x :string-value #f :width 8 :font "fixed" :value x)
|
||||
:fill "x" :expand #f :anchor "w" :side "top"))
|
||||
'("10pt" "12pt" "14pt" "18pt"))
|
||||
|
||||
|
||||
(define lf2 (make <Labeled-Frame> :title "Type" :parent top))
|
||||
(pack lf2 :fill "both" :expand #t :side "left")
|
||||
|
||||
(for-each (lambda (x)
|
||||
(pack (make <Radio-button> :anchor "w" :parent lf2 :variable 'type
|
||||
:text x :string-value #f :width 15 :font "fixed" :value x)
|
||||
:fill "x" :expand #f :anchor "w" :side "top"))
|
||||
'("Bold" "Italic" "Normal")))
|
||||
|
||||
;=============================================================================
|
||||
(define (demo-paned)
|
||||
(let* ((tl (make <Toplevel> :title "Paned demo"))
|
||||
(hp (make <HPaned> :fraction 0.3 :width 300 :height 300 :parent tl))
|
||||
(f1 (make <Label> :text "top pane" :parent (top-frame-of hp)))
|
||||
(f2 (make <Label> :text "bottom-pane" :parent (bottom-frame-of hp)))
|
||||
(vp (make <VPaned> :fraction 0.3 :width 300 :height 300 :parent tl))
|
||||
(f3 (make <Label> :text "left pane" :parent (left-frame-of vp)))
|
||||
(f4 (make <Label> :text "right-pane" :parent (right-frame-of vp))))
|
||||
(pack f1 f2 f3 f4 :expand #t)
|
||||
(pack hp vp)))
|
||||
|
||||
;=============================================================================
|
||||
(define (demo-scroll-canvas . parent)
|
||||
(let* ((top (if (null? parent)
|
||||
(make <Toplevel> :title "Scroll Canvas")
|
||||
(car parent)))
|
||||
(c (make <Scroll-Canvas> :parent top :background "#c4b6a7"
|
||||
:h-scroll-side "bottom" :scroll-region '(0 0 1000 1000))))
|
||||
(make <Rectangle> :parent c :fill "IndianRed1" :coords '(0 0 50 50))
|
||||
(make <Oval> :parent c :fill "DarkOliveGreen" :coords '(100 100 150 150))
|
||||
(bind-for-dragging c)
|
||||
(pack c :fill "both" :expand #t)))
|
||||
|
||||
;=============================================================================
|
||||
(define (demo-scroll-listbox)
|
||||
(let* ((tl (make <Toplevel> :title "Scroll box"))
|
||||
(sb (make <Scroll-listbox> :parent tl :geometry "20x6")))
|
||||
;; add some entries into the listbox
|
||||
(for-each (lambda (x)
|
||||
(insert (listbox-of sb) 0 x))
|
||||
(append composite-widgets composite-widgets))
|
||||
(pack sb)))
|
||||
|
||||
;=============================================================================
|
||||
(define (demo-scroll-text . parent)
|
||||
(let* ((top (if (null? parent)
|
||||
(make <Toplevel> :title "Scroll Canvas")
|
||||
(car parent)))
|
||||
(t1 (make <Scroll-Text> :highlight-thickness 0 :parent top :height 8
|
||||
:background "lightblue3" :wrap "word"
|
||||
:value "Hi!I'm a text window\n\n\n\n\n\n\n\n\n\n\n\n\n\n\nEnd"))
|
||||
(t2 (make <Scroll-Text> :highlight-thickness 0 :parent top
|
||||
:background "lightblue3" :wrap "word" :height 4
|
||||
:value "Hi, I'm also embedded in a window.\nUse the mouse in the border of my enclosing window to enlarge or shrink this editor")))
|
||||
(pack t1 t2 :fill "both" :expand #t)))
|
||||
|
||||
;=============================================================================
|
||||
|
||||
(define (demo-multiple-window)
|
||||
;;
|
||||
;; Make a Menu bar
|
||||
;;
|
||||
(define tl (make <Toplevel> :title "Multiple and Inner windows demo"))
|
||||
(define top (make <Frame> :parent tl))
|
||||
(define col '#("violet" "skyblue1" "Misty Rose" "Plum" "grey40"))
|
||||
(define menu (make-menubar top
|
||||
`(("Menu"
|
||||
("Add one" ,(let ((counter 0))
|
||||
(lambda ()
|
||||
(place (make <Inner-window> :parent f
|
||||
:title (format #f "Window #~A" counter)
|
||||
:background (vector-ref col (random 5)))
|
||||
:x (random 200) :y (random 200))
|
||||
(set! counter (1+ counter)))))
|
||||
("")
|
||||
("Quit" ,(lambda () (destroy tl)))))))
|
||||
(pack menu :side "left" :expand #f)
|
||||
(pack top :fill "x")
|
||||
;;
|
||||
;; Make a multiple window
|
||||
;;
|
||||
(define f (make <Multiple-window> :parent tl :background "cyan4"))
|
||||
(pack f :fill "both" :expand #t)
|
||||
|
||||
(define f1 (make <Inner-window> :parent f :title "A Text window"))
|
||||
(define f2 (make <Inner-window> :parent f :title "A canvas window"))
|
||||
(demo-scroll-text f1)
|
||||
(demo-scroll-canvas f2)
|
||||
|
||||
(place f1 :x 100 :y 70)
|
||||
(place f2 :x 10 :y 10))
|
||||
|
||||
;=============================================================================
|
||||
(define (demo-valued-gauge)
|
||||
(let* ((top (make <Toplevel> :title "Valued Gauge widget"))
|
||||
(g (make <Valued-Gauge> :parent top :width 400 :height 15)))
|
||||
(pack g :expand #t :fill "both")
|
||||
(dotimes (i 101)
|
||||
(slot-set! g 'value i)
|
||||
(after 5)
|
||||
(update))))
|
||||
|
|
@ -1,7 +1,9 @@
|
|||
#!/bin/sh
|
||||
:;exec /usr/local/bin/stk -f "$0" "$@"
|
||||
;;;;
|
||||
;;;; t e r m . s t k -- A simple terminal emulator written in Scheme
|
||||
;;;;
|
||||
;;;; Copyright © 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
;;;; Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
;;;;
|
||||
;;;; Permission to use, copy, and/or distribute this software and its
|
||||
;;;; documentation for any purpose and without fee is hereby granted, provided
|
||||
|
|
@ -11,12 +13,12 @@
|
|||
;;;; permission of the copyright holder.
|
||||
;;;; This software is provided ``as is'' without express or implied warranty.
|
||||
;;;;
|
||||
;;;; $Id: term.stk 1.2 Mon, 16 Feb 1998 08:28:39 +0100 eg $
|
||||
;;;;
|
||||
;;;; Author: Erick Gallesio [eg@unice.fr]
|
||||
;;;; Creation date: 7-Oct-1995 10:39
|
||||
;;;; Last file update: 22-Feb-1996 00:29
|
||||
;;;; Last file update: 12-Feb-1998 15:31
|
||||
|
||||
(require "sterm")
|
||||
|
||||
(wm 'withdraw *root*)
|
||||
(sterm) ;; Easy no?
|
||||
|
|
|
|||
|
|
@ -109,7 +109,7 @@
|
|||
(let ((name (vector-ref turtle-colours n)))
|
||||
(if (string=? name "")
|
||||
""
|
||||
(string-append "@" *STk-library* "/images/" name))))
|
||||
(string-append "@" *STk-library* "/Images/" name))))
|
||||
|
||||
(define (go length)
|
||||
(let ((newx (+ turtle-x (* (cos (/ turtle-direction turtle-d2r)) length)))
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@
|
|||
(require "Tk-classes")
|
||||
|
||||
(define demo-font "-*-Helvetica-Medium-R-Normal--*-140-*-*-*-*-*-*")
|
||||
(define *STk-images* (string-append *STk-library* "/images/"))
|
||||
(define *STk-images* (string-append *STk-library* "/Images/"))
|
||||
(set! *load-path* `("./Widget"
|
||||
,(string-append *STk-library* "/demos")
|
||||
,@*load-path*))
|
||||
|
|
@ -28,7 +28,7 @@
|
|||
|
||||
;; Pack the demo text
|
||||
(when text
|
||||
(pack (make <Label> :font demo-font
|
||||
(pack (make <Label> :font demo-font
|
||||
:parent t
|
||||
:wrap-length "4i"
|
||||
:justify "left"
|
||||
|
|
@ -234,9 +234,6 @@
|
|||
'()))
|
||||
(ELSE (loop (cdr t))))))
|
||||
|
||||
(define (NYI)
|
||||
(error "This demo is not yet implemented"))
|
||||
|
||||
;;
|
||||
;; Autolooads
|
||||
;;
|
||||
|
|
@ -268,9 +265,10 @@
|
|||
(autoload "Wplot" demo-plot)
|
||||
(autoload "Wctext" demo-ctext)
|
||||
(autoload "Warrow" demo-arrow)
|
||||
(define demo-ruler NYI)
|
||||
(define demo-floor NYI)
|
||||
(define demo-cscroll NYI)
|
||||
(autoload "Wruler" demo-ruler)
|
||||
(autoload "Wfloor" demo-floor)
|
||||
(autoload "Wcscroll" demo-cscroll)
|
||||
|
||||
|
||||
(autoload "Wvscale" demo-vscale)
|
||||
(autoload "Whscale" demo-hscale)
|
||||
|
|
|
|||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
|
|
@ -14,7 +14,7 @@
|
|||
%
|
||||
% Author: Erick Gallesio [eg@unice.fr]
|
||||
% Creation date: in 1993
|
||||
% Last file update: 21-Jul-1996 19:47
|
||||
% Last file update: 29-Mar-1997 18:30
|
||||
%
|
||||
|
||||
\documentclass[10pt]{article}
|
||||
|
|
|
|||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
26
Doc/Makefile
26
Doc/Makefile
|
|
@ -13,23 +13,20 @@
|
|||
#
|
||||
# Author: Erick Gallesio [eg@unice.fr]
|
||||
# Creation date: 21-Oct-1994 11:25
|
||||
# Last file update: 24-Jul-1996 19:04
|
||||
# Last file update: 20-Aug-1997 14:00
|
||||
|
||||
include ../config.make
|
||||
|
||||
# Don't use $(mandir) for manual. Always put it in $(prefix)/man/man1
|
||||
# This allows us to avoid the destruction of true Tk4.0 man pages
|
||||
# which are quite different.
|
||||
MAN1_DIR=$(mandir)/man1
|
||||
MANN_DIR=$(mandir)/mann
|
||||
|
||||
|
||||
DIRS=Extension Reference STklos+Tk Manual Isotas96
|
||||
|
||||
install:
|
||||
install: install.man
|
||||
|
||||
all: dvi ps
|
||||
|
||||
|
||||
dvi:
|
||||
for i in $(DIRS) ;do \
|
||||
(cd $$i; $(MAKE) dvi); \
|
||||
|
|
@ -39,22 +36,9 @@ ps:
|
|||
for i in $(DIRS) ;do \
|
||||
(cd $$i; $(MAKE) ps); \
|
||||
done
|
||||
|
||||
|
||||
install.man:
|
||||
-if [ ! -d $(mandir) ] ; then mkdir -p $(mandir); fi
|
||||
rm -f $(stkdir)/man
|
||||
(cd $(stkdir) ; ln -s $(VERSION)/man ./man)
|
||||
-if [ ! -d $(MAN1_DIR) ] ; then mkdir -p $(MAN1_DIR); fi
|
||||
rm -f $(MAN1_DIR)/*.n $(MAN1_DIR)/stk.1 $(MAN1_DIR)/snow.1
|
||||
$(CP) Manual/STk-man.macros $(MAN1_DIR)
|
||||
$(CP) Manual/stk.1 $(MAN1_DIR)/stk.1
|
||||
ln $(MAN1_DIR)/stk.1 $(MAN1_DIR)/snow.1
|
||||
chmod 444 $(MAN1_DIR)/*
|
||||
-if [ ! -d $(MANN_DIR) ] ; then mkdir -p $(MANN_DIR); fi
|
||||
$(CP) Manual/STk-man.macros $(MANN_DIR)
|
||||
(cd Manual ;for i in *.n ;do \
|
||||
$(CP) $$i $(MANN_DIR)/stk_$$i; \
|
||||
done)
|
||||
(cd Manual; make install.man)
|
||||
|
||||
clean:
|
||||
for i in $(DIRS) ;do \
|
||||
|
|
|
|||
|
|
@ -1,6 +1,22 @@
|
|||
###
|
||||
### Makefile for the man pages
|
||||
###
|
||||
# Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
||||
#
|
||||
# Permission to use, copy, and/or distribute this software and its
|
||||
# documentation for any purpose and without fee is hereby granted, provided
|
||||
# that both the above copyright notice and this permission notice appear in
|
||||
# all copies and derived works. Fees for distribution or use of this
|
||||
# software or derived works may only be charged with express written
|
||||
# permission of the copyright holder.
|
||||
# This software is provided ``as is'' without express or implied warranty.
|
||||
#
|
||||
# Author: Erick Gallesio [eg@unice.fr]
|
||||
# Creation date: 21-Oct-1994 11:25
|
||||
# Last file update: 30-Oct-1996 12:00
|
||||
|
||||
|
||||
include ../../config.make
|
||||
|
||||
MAN1_DIR=$(mandir)/man1
|
||||
MANN_DIR=$(mandir)/mann
|
||||
|
||||
|
||||
all: ps txt
|
||||
|
|
@ -26,6 +42,27 @@ stk.ps: stk.1
|
|||
stk.txt: stk.1
|
||||
nroff -man stk.1 > stk.txt
|
||||
|
||||
#
|
||||
# install.man
|
||||
#
|
||||
|
||||
install.man:
|
||||
-if [ ! -d $(mandir) ] ; then mkdir -p $(mandir); fi
|
||||
rm -f $(stkdir)/man
|
||||
(cd $(stkdir) ; ln -s $(VERSION)/man ./man)
|
||||
-if [ ! -d $(MAN1_DIR) ] ; then mkdir -p $(MAN1_DIR); fi
|
||||
rm -f $(MAN1_DIR)/*.n $(MAN1_DIR)/stk.1 $(MAN1_DIR)/snow.1
|
||||
$(CP) STk-man.macros $(MAN1_DIR)
|
||||
$(CP) stk.1 $(MAN1_DIR)/stk.1
|
||||
ln $(MAN1_DIR)/stk.1 $(MAN1_DIR)/snow.1
|
||||
chmod 444 $(MAN1_DIR)/*
|
||||
-if [ ! -d $(MANN_DIR) ] ; then mkdir -p $(MANN_DIR); fi
|
||||
$(CP) STk-man.macros $(MANN_DIR)
|
||||
for i in *.n ;do \
|
||||
$(CP) $$i $(MANN_DIR)/stk_$$i; \
|
||||
done
|
||||
../../Src/test-stk -no -file make-link $(MANN_DIR)
|
||||
|
||||
clean:
|
||||
rm -f *~
|
||||
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
'\" @(#) bind.n 1.35 95/08/26 16:27:12
|
||||
'\"
|
||||
.so STk-man.macros
|
||||
.TH bind n 3.1 STk "Tk Built-In Commands"
|
||||
.TH bind n 3.2 STk "Tk Built-In Commands"
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
|
|
@ -70,7 +70,7 @@ the binding applies to all windows in the application.
|
|||
The \fIsequence\fR argument specifies a sequence of one or more
|
||||
event patterns, with optional white space between the patterns. Each
|
||||
event pattern may
|
||||
take either of two forms. In the simplest case it is a single
|
||||
take one of three forms. In the simplest case it is a single
|
||||
printing ASCII character, such as \fBa\fR or \fB[\fR. The character
|
||||
may not be a space character or the character \fB<\fR. This form of
|
||||
pattern matches a \fBKeyPress\fR event for the particular
|
||||
|
|
@ -85,7 +85,19 @@ type, and an extra piece of information (\fIdetail\fR) identifying
|
|||
a particular button or keysym. Any of the fields may be omitted,
|
||||
as long as at least one of \fItype\fR and \fIdetail\fR is present.
|
||||
The fields must be separated by white space or dashes.
|
||||
|
||||
.PP
|
||||
The third form of pattern is used to specify a user-defined, named virtual
|
||||
event. It has the following syntax:
|
||||
.CS
|
||||
\fB<<\fIname\fB>>\fR
|
||||
.CE
|
||||
The entire virtual event pattern is surrounded by double angle brackets.
|
||||
Inside the angle brackets is the user-defined name of the virtual event.
|
||||
Modifiers, such as \fBShift\fR or \fBControl\fR, may not be combined with a
|
||||
virtual event to modify it. Bindings on a virtual event may be created
|
||||
before the virtual event is defined, and if the definition of a virtual
|
||||
event changes dynamically, all windows bound to that virtual event will
|
||||
respond immediately to the new definition.
|
||||
.SH "MODIFIERS"
|
||||
.PP
|
||||
Modifiers consist of any of the following values:
|
||||
|
|
@ -149,7 +161,8 @@ Circulate FocusOut Property
|
|||
Colormap Gravity Reparent
|
||||
Configure KeyPress, Key Unmap
|
||||
Destroy KeyRelease Visibility
|
||||
Enter Leave\fR
|
||||
Enter Leave Activate
|
||||
Deactivate\fR
|
||||
.DE
|
||||
.PP
|
||||
The last part of a long event specification is \fIdetail\fR. In the
|
||||
|
|
@ -230,16 +243,16 @@ For events other than these, the substituted string is undefined.
|
|||
The \fIfocus\fR field from the event (\fB#f\fR or \fB#t\fR). Valid only
|
||||
for \fBEnter\fR and \fBLeave\fR events.
|
||||
.IP \fBh\fR 5
|
||||
The \fIheight\fR field from the event. Valid only for \fBConfigure\fR,
|
||||
\fBExpose\fR, and \fBGraphicsExpose\fR events.
|
||||
The \fIheight\fR field from the event. Valid only for \fBConfigure\fR and
|
||||
\fBExpose\fR events.
|
||||
.IP \fBk\fR 5
|
||||
The \fIkeycode\fR field from the event. Valid only for \fBKeyPress\fR
|
||||
and \fBKeyRelease\fR events.
|
||||
.IP \fBm\fR 5
|
||||
The \fImode\fR field from the event. The substituted string is one of
|
||||
\fBNotifyNormal\fR, \fBNotifyGrab\fR, \fBNotifyUngrab\fR, or
|
||||
\fBNotifyWhileGrabbed\fR. Valid only for \fBEnterWindow\fR,
|
||||
\fBFocusIn\fR, \fBFocusOut\fR, and \fBLeaveWindow\fR events.
|
||||
\fBNotifyWhileGrabbed\fR. Valid only for \fBEnter\fR,
|
||||
\fBFocusIn\fR, \fBFocusOut\fR, and \fBLeave\fR events.
|
||||
.IP \fBo\fR 5
|
||||
The \fIoverride_redirect\fR field from the event. Valid only for
|
||||
\fBMap\fR, \fBReparent\fR, and \fBConfigure\fR events.
|
||||
|
|
@ -250,8 +263,7 @@ for \fBCirculate\fR events.
|
|||
.IP \fBs\fR 5
|
||||
The \fIstate\fR field from the event. For \fBButtonPress\fR,
|
||||
\fBButtonRelease\fR, \fBEnter\fR, \fBKeyPress\fR, \fBKeyRelease\fR,
|
||||
\fBLeave\fR, and \fBMotion\fR events,
|
||||
a decimal string
|
||||
\fBLeave\fR, and \fBMotion\fR events, a decimal string
|
||||
is substituted. For \fBVisibility\fR, one of the strings
|
||||
\fBVisibilityUnobscured\fR, \fBVisibilityPartiallyObscured\fR,
|
||||
and \fBVisibilityFullyObscured\fR is substituted.
|
||||
|
|
@ -260,7 +272,7 @@ The \fItime\fR field from the event. Valid only for events that
|
|||
contain a \fItime\fR field.
|
||||
.IP \fBw\fR 5
|
||||
The \fIwidth\fR field from the event. Valid only for
|
||||
\fBConfigure\fR, \fBExpose\fR, and \fBGraphicsExpose\fR events.
|
||||
\fBConfigure\fR and \fBExpose\fR events.
|
||||
.IP \fBx\fR 5
|
||||
The \fIx\fR field from the event. Valid only for events containing
|
||||
an \fIx\fR field.
|
||||
|
|
@ -352,11 +364,32 @@ than one that doesn't;
|
|||
(c) if the modifiers specified in one pattern are a subset of the
|
||||
modifiers in another pattern, then the pattern with more modifiers
|
||||
is more specific.
|
||||
If the matching sequences contain more than
|
||||
one event, then tests (c)-(e) are applied in order from the most
|
||||
recent event to the least recent event in the sequences. If these
|
||||
tests fail to determine a winner, then the most recently registered
|
||||
sequence is the winner.
|
||||
(d) a virtual event whose physical pattern matches the sequence is less
|
||||
specific than the same physical pattern that is not associated with a
|
||||
virtual event.
|
||||
(e) given a sequence that matches two or more virtual events, one
|
||||
of the virtual events will be chosen, but the order is undefined.
|
||||
.PP
|
||||
If the matching sequences contain more than one event, then tests
|
||||
(c)-(e) are applied in order from the most recent event to the least recent
|
||||
event in the sequences. If these tests fail to determine a winner, then the
|
||||
most recently registered sequence is the winner.
|
||||
.PP
|
||||
If there are two (or more) virtual events that are both triggered by the
|
||||
same sequence, and both of those virtual events are bound to the same window
|
||||
tag, then only one of the virtual events will be triggered, and it will
|
||||
be picked at random:
|
||||
.CS
|
||||
(event 'add "<<Paste>>" "<Control-y>")
|
||||
(event 'add "<<Paste>>" "<Button-2>")
|
||||
(event 'add "<<Scroll>>" "<Button-2>")
|
||||
(bind "Entry" "<<Paste>>" (lambda () (display "Paste\n")))
|
||||
(bind "Entry" "<<Scroll>>" (lambda () (display "Scroll\n")))
|
||||
.CE
|
||||
If the user types Control-y, the \fB<<Paste>>\fR binding
|
||||
will be invoked, but if the user presses button 2 then one of
|
||||
either the \fB<<Paste>>\fR or the \fB<<Scroll>>\fR bindings will
|
||||
be invoked, but exactly which one gets invoked is undefined.
|
||||
.PP
|
||||
If an X event does not match any of the existing bindings, then the
|
||||
event is ignored.
|
||||
|
|
@ -409,7 +442,7 @@ the last one is used for purposes of matching binding sequences.
|
|||
.SH ERRORS
|
||||
.PP
|
||||
If an error occurs in executing the script for a binding then the
|
||||
\fBtkerror\fR mechanism is used to report the error.
|
||||
\fBbgerror\fR mechanism is used to report the error.
|
||||
|
||||
.SH "SEE ALSO"
|
||||
bindtags, tkerror
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
'\" @(#) bindtags.n 1.6 95/08/12 17:35:01
|
||||
'\"
|
||||
.so STk-man.macros
|
||||
.TH bindtags n 3.1 STk "Tk Built-In Commands"
|
||||
.TH bindtags n 4.0 STk "Tk Built-In Commands"
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
|
|
@ -60,6 +60,8 @@ reverses the order in which binding scripts will be evaluated for
|
|||
a button named \fB.b\fR so that \fB"all"\fR bindings are invoked
|
||||
first, following by bindings for \fB.b\fR's toplevel (\fB*root\fR* or ``.''),
|
||||
followed by class bindings, followed by bindings for \fB.b\fR.
|
||||
If \fItagList\fR is an empty list then the binding tags for \fIwindow\fR
|
||||
are returned to the default state described above.
|
||||
.PP
|
||||
The \fBbindtags\fR procedure may be used to introduce arbitrary
|
||||
additional binding tags for a window, or to remove standard tags.
|
||||
|
|
|
|||
|
|
@ -111,4 +111,4 @@ this case the procedure returns an empty string.
|
|||
\fBimage create bitmap\fR procedure.
|
||||
|
||||
.SH SEE ALSO
|
||||
image, photo, pixmap
|
||||
make-image, image, jpeg, photo, pixmap
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
'\" @(#) button.n 1.33 95/08/12 17:35:02
|
||||
'\"
|
||||
.so STk-man.macros
|
||||
.TH button n 3.1 STk "Tk Built-In Commands"
|
||||
.TH button n 4.0 STk "Tk Built-In Commands"
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
|
|
@ -28,6 +28,23 @@ button \- Create and manipulate button widgets
|
|||
Specifies a STk procedure to associate with the button. This procedure
|
||||
is typically invoked when mouse button 1 is released over the button
|
||||
window.
|
||||
OP :default default Default default
|
||||
.VS
|
||||
Specifies one of three states for the default ring: \fB"normal"\fR,
|
||||
\fB"active"\fR, or \fB"disabled"\fR. In active state, the button is drawn
|
||||
with the platform specific appearance for a default button. In normal
|
||||
state, the button is drawn with the platform specific appearance for a
|
||||
non-default button, leaving enough space to draw the default button
|
||||
appearance. The normal and active states will result in buttons of
|
||||
the same size. In disabled state, the button is drawn with the
|
||||
non-default button appearance without leaving space for the default
|
||||
appearance. The disabled state may result in a smaller button than
|
||||
the active state.
|
||||
ring.
|
||||
.OP :environment environment Environment environment
|
||||
Specifies the environment in which the \fB:textvariable\fR must be taken.
|
||||
By default, the value of this option is the STk global environment.
|
||||
.VE
|
||||
.OP :height height Height height
|
||||
Specifies a desired height for the button.
|
||||
If an image or bitmap is being displayed in the button then the value is in
|
||||
|
|
@ -68,8 +85,7 @@ text, and initial relief. The \fBbutton\fR procedure returns its
|
|||
there must not exist a window named \fIwidget\-name\fR, but
|
||||
\fIwidget\-name\fR's parent must exist.
|
||||
.PP
|
||||
A button is a widget
|
||||
that displays a textual string, bitmap or image.
|
||||
A button is a widget that displays a textual string, bitmap or image.
|
||||
If text is displayed, it must all be in a single font, but it
|
||||
can occupy multiple lines on the screen (if it contains newlines
|
||||
or if wrapping occurs because of the \fBwrapLength\fR option) and
|
||||
|
|
@ -132,10 +148,14 @@ This procedure is ignored if the button's state is \fBdisabled\fR.
|
|||
.SH "DEFAULT BINDINGS"
|
||||
.PP
|
||||
Tk automatically creates class bindings for buttons that give them
|
||||
the following default behavior:
|
||||
default behavior:
|
||||
.IP [1]
|
||||
A button activates whenever the mouse passes over it and deactivates
|
||||
whenever the mouse leaves the button.
|
||||
.VS
|
||||
Under Windows, this binding is only active when mouse button 1 has
|
||||
been pressed over the button.
|
||||
.VE
|
||||
.IP [2]
|
||||
A button's relief is changed to sunken whenever mouse button 1 is
|
||||
pressed over the button, and the relief is restored to its original
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
'\" @(#) canvas.n 1.44 95/08/12 17:35:03
|
||||
'\"
|
||||
.so STk-man.macros
|
||||
.TH canvas n 3.1 STk "Tk Built-In Commands"
|
||||
.TH canvas n 4.0 STk "Tk Built-In Commands"
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
|
|
@ -107,6 +107,12 @@ When a new item is created it is placed at the end of the
|
|||
display list, on top of everything else.
|
||||
Widget procedures may be used to re-arrange the order of the
|
||||
display list.
|
||||
.PP
|
||||
Window items are an exception to the above rules. The underlying
|
||||
window systems require them always to be drawn on top of other items.
|
||||
In addition, the stacking order of window items
|
||||
is not affected by any of the canvas widget commands; you must use
|
||||
the \fBraise\fR and \fBlower\fR Tk commands instead.
|
||||
|
||||
.SH "ITEM IDS AND TAGS"
|
||||
.PP
|
||||
|
|
@ -354,18 +360,21 @@ Example:
|
|||
.RE
|
||||
.RS
|
||||
.PP
|
||||
The only events for which bindings may be specified are those related
|
||||
to the mouse and keyboard, such as \fBEnter\fR, \fBLeave\fR,
|
||||
\fBButtonPress\fR, \fBMotion\fR, and \fBKeyPress\fR.
|
||||
The handling of events in canvases uses the current item defined
|
||||
in ITEM IDS AND TAGS above.
|
||||
\fBEnter\fR and \fBLeave\fR events trigger for an item when it
|
||||
becomes the current item or ceases to be the current item; note
|
||||
that these events are different than \fBEnter\fR and \fBLeave\fR
|
||||
events for windows.
|
||||
Mouse-related events are directed to the current item, if any.
|
||||
Keyboard-related events are directed to the focus item, if any
|
||||
(see the \fBfocus\fR widget procedure below for more on this).
|
||||
.VS
|
||||
The only events for which bindings may be specified are those related to
|
||||
the mouse and keyboard (such as \fBEnter\fR, \fBLeave\fR,
|
||||
\fBButtonPress\fR, \fBMotion\fR, and \fBKeyPress\fR) or virtual events.
|
||||
The handling of events in canvases uses the current item defined in ITEM
|
||||
IDS AND TAGS above. \fBEnter\fR and \fBLeave\fR events trigger for an
|
||||
item when it becomes the current item or ceases to be the current item;
|
||||
note that these events are different than \fBEnter\fR and \fBLeave\fR
|
||||
events for windows. Mouse-related events are directed to the current
|
||||
item, if any. Keyboard-related events are directed to the focus item, if
|
||||
any (see the \fBfocus\fR widget command below for more on this). If a
|
||||
virtual event is used in a binding, that binding can trigger only if the
|
||||
virtual event is defined by an underlying mouse-related or
|
||||
keyboard-related event.
|
||||
.VE
|
||||
.PP
|
||||
It is possible for multiple bindings to match a particular event.
|
||||
This could occur, for example, if one binding is associated with the
|
||||
|
|
@ -391,7 +400,7 @@ for the window as a whole.
|
|||
(\fIwidget\-name '\fBcanvasx \fIscreenx\fR)
|
||||
.TP
|
||||
(\fIwidget\-name '\fBcanvasx \fIscreenx\fR \fIgridspacing\fR)
|
||||
Given a screen x-coordinate \fIscreenx\fR this procedure returns
|
||||
Given a window x-coordinate in the canvas \fIscreenx\fR, this command returns
|
||||
the canvas x-coordinate that is displayed at that location.
|
||||
If \fIgridspacing\fR is specified, then the canvas coordinate is
|
||||
rounded to the nearest multiple of \fIgridspacing\fR units.
|
||||
|
|
@ -399,7 +408,7 @@ rounded to the nearest multiple of \fIgridspacing\fR units.
|
|||
(\fIwidget\-name '\fBcanvasy \fIscreeny\fR)
|
||||
.TP
|
||||
(\fIwidget\-name '\fBcanvasy \fIscreeny\fR \fIgridspacing\fR)
|
||||
Given a screen y-coordinate \fIscreeny\fR this procedure returns
|
||||
Given a window y-coordinate in the canvas \fIscreeny\fR this command returns
|
||||
the canvas y-coordinate that is displayed at that location.
|
||||
If \fIgridspacing\fR is specified, then the canvas coordinate is
|
||||
rounded to the nearest multiple of \fIgridspacing\fR units.
|
||||
|
|
@ -478,6 +487,7 @@ meet the constraints specified by \fIsearchProcedure\fR and
|
|||
\fIarg\fR's.
|
||||
\fISearchProcedure\fR and \fIargs\fR have any of the forms
|
||||
accepted by the \fBaddtag\fR procedure.
|
||||
The items are returned in stacking order, with the lowest item first.
|
||||
.TP
|
||||
(\fIwidget\-name '\fBfocus \fR)
|
||||
.TP
|
||||
|
|
@ -592,6 +602,10 @@ but the relative order of the moved items will not be changed.
|
|||
\fIBelowThis\fR is a tag or id; if it refers to more than one
|
||||
item then the first (lowest) of these items in the display list is used
|
||||
as the destination location for the moved items.
|
||||
Note: this procedure has no effect on window items. Window items always
|
||||
obscure other item types, and the stacking order of window items is
|
||||
determined by the \fBraise\fR and \fBlower\fR commands, not the
|
||||
\fBraise\fR and \fBlower\fR widget commands for canvases.
|
||||
This procedure returns an empty list.
|
||||
.TP
|
||||
(\fIwidget\-name '\fBmove \fItagOrId xAmount yAmount\fR)
|
||||
|
|
@ -606,6 +620,14 @@ Generate a Postscript representation for part or all of the canvas.
|
|||
If the \fB:file\fR option is specified then the Postscript is written
|
||||
to a file and an empty list is returned; otherwise the Postscript
|
||||
is returned as the result of the procedure.
|
||||
'\".VS
|
||||
'\"If the interpreter that owns the canvas is marked as safe, the operation
|
||||
'\"will fail because safe interpreters are not allowed to write files.
|
||||
'\"If the \fB\-channel\fR option is specified, the argument denotes the name
|
||||
'\"of a channel already opened for writing. The Postscript is written to
|
||||
'\"that channel, and the channel is left open for further writing at the end
|
||||
'\"of the operation.
|
||||
'\".VE
|
||||
The Postscript is created in Encapsulated Postscript form using
|
||||
version 3.0 of the Document Structuring Conventions.
|
||||
Note: by default Postscript is only generated for information that
|
||||
|
|
@ -719,6 +741,10 @@ but the relative order of the moved items will not be changed.
|
|||
\fIAboveThis\fR is a tag or id; if it refers to more than one
|
||||
item then the last (topmost) of these items in the display list is used
|
||||
as the destination location for the moved items.
|
||||
Note: this procedure has no effect on window items. Window items always
|
||||
obscure other item types, and the stacking order of window items is
|
||||
determined by the \fBraise\fR and \fBlower\fR commands, not the
|
||||
\fBraise\fR and \fBlower\fR widget commands for canvases.
|
||||
This procedure returns an empty list.
|
||||
.TP
|
||||
(\fIwidget\-name '\fBscale \fItagOrId xOrigin yOrigin xScale yScale\fR)
|
||||
|
|
@ -1159,7 +1185,7 @@ irrelevant.
|
|||
\fB:smooth \fIboolean\fR
|
||||
\fIBoolean\fR must have one of the forms accepted by \fBTk_GetBoolean\fR.
|
||||
It indicates whether or not the line should be drawn as a curve.
|
||||
If so, the line is rendered as a set of Bezier splines: one spline
|
||||
If so, the line is rendered as a set of parabolic splines: one spline
|
||||
is drawn for the first and second line segments, one for the second
|
||||
and third, and so on. Straight-line segments can be generated within
|
||||
a curve by duplicating the end-points of the desired line segment.
|
||||
|
|
@ -1286,7 +1312,7 @@ This option defaults to empty (no outline).
|
|||
\fIBoolean\fR must have one of the forms accepted by \fBTk_GetBoolean\fR
|
||||
It indicates whether or not the polygon should be drawn with a
|
||||
curved perimeter.
|
||||
If so, the outline of the polygon becomes a set of Bezier splines,
|
||||
If so, the outline of the polygon becomes a set of parabolic splines,
|
||||
one spline for the first and second line segments, one for the second
|
||||
and third, and so on. Straight-line segments can be generated in a
|
||||
smoothed polygon by duplicating the end-points of the desired line segment.
|
||||
|
|
@ -1518,6 +1544,12 @@ Specifies the window to associate with this item.
|
|||
The window specified by \fIwidget\-name\fR must either be a child of
|
||||
the canvas widget or a child of some ancestor of the canvas widget.
|
||||
\fIPathName\fR may not refer to a top-level window.
|
||||
.PP
|
||||
Note: due to restrictions in the ways that windows are managed, it is not
|
||||
possible to draw other graphical items (such as lines and images) on top
|
||||
of window items. A window item always obscures any graphics that
|
||||
overlap it, regardless of their order in the display list.
|
||||
|
||||
|
||||
.SH "APPLICATION-DEFINED ITEM TYPES"
|
||||
.PP
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
'\" @(#) checkbutton.n 1.36 95/08/12 17:35:04
|
||||
'\"
|
||||
.so STk-man.macros
|
||||
.TH checkbutton n 3.1 STk "Tk Built-In Commands"
|
||||
.TH checkbutton n 4.0 STk "Tk Built-In Commands"
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
|
|
@ -29,6 +29,11 @@ Specifies a STk procedure to associate with the button. This procedure
|
|||
is typically invoked when mouse button 1 is released over the button
|
||||
window. The button's global variable (\fB:variable\fR option) will
|
||||
be updated before the procedure is invoked.
|
||||
.VS
|
||||
.OP :environment environment Environment environment
|
||||
Specifies the environment in which the \fB:textvariable\fR must be taken.
|
||||
By default, the value of this option is the STk global environment.
|
||||
.VE
|
||||
.OP :height height Height height
|
||||
Specifies a desired height for the button.
|
||||
If an image or bitmap is being displayed in the button then the value is in
|
||||
|
|
@ -49,7 +54,9 @@ Specifies value to store in the button's associated variable whenever
|
|||
this button is selected. Defaults to \fB#t\fR.
|
||||
.OP :selectcolor selectColor Background select-color
|
||||
Specifies a background color to use when the button is selected.
|
||||
If \fBindicatorOn\fR is true then the color applicies to the indicator.
|
||||
If \fBindicatorOn\fR is true then the color applies to the indicator.
|
||||
Under Windows, this color is used as the background for the indicator
|
||||
regardless of the select state.
|
||||
If \fBindicatorOn\fR is false, this color is used as the background
|
||||
for the entire widget, in place of \fBbackground\fR or \fBactiveBackground\fR,
|
||||
whenever the widget is selected.
|
||||
|
|
@ -133,12 +140,18 @@ checkbutton.
|
|||
.PP
|
||||
In addition, checkbuttons can be \fIselected\fR.
|
||||
If a checkbutton is selected then the indicator is normally
|
||||
drawn with a sunken relief and a special color, and
|
||||
.VS
|
||||
drawn with a selected appearance, and
|
||||
a STk variable associated with the checkbutton is set to a particular
|
||||
value (normally 1).
|
||||
value (normally #t).
|
||||
Under Unix, the indicator is drawn with a sunken relief and a special
|
||||
color. Under Windows, the indicator is drawn with a check mark inside.
|
||||
If the checkbutton is not selected, then the indicator is drawn with a
|
||||
raised relief and no special color, and the associated variable is
|
||||
set to a different value (typically 0).
|
||||
deselected appearance, and the associated variable is
|
||||
set to a different value (typically #f).
|
||||
Under Unix, the indicator is drawn with a raised relief and no special
|
||||
color. Under Windows, the indicator is drawn without a check mark inside.
|
||||
.VE
|
||||
By default, the name of the variable associated with a checkbutton is the
|
||||
same as the \fIname\fR used to create the checkbutton.
|
||||
The variable name, and the ``on'' and ``off'' values stored in it,
|
||||
|
|
@ -215,16 +228,25 @@ modifying its associated variable to reflect the new state.
|
|||
.PP
|
||||
Tk automatically creates class bindings for checkbuttons that give them
|
||||
the following default behavior:
|
||||
.VS
|
||||
.IP [1]
|
||||
A checkbutton activates whenever the mouse passes over it and deactivates
|
||||
whenever the mouse leaves the checkbutton.
|
||||
On Unix systems, a checkbutton activates whenever the mouse passes
|
||||
over it and deactivates whenever the mouse leaves the checkbutton. On
|
||||
Windows systems, when mouse button 1 is pressed over a
|
||||
checkbutton, the button activates whenever the mouse pointer is inside
|
||||
the button, and deactivates whenever the mouse pointer leaves the
|
||||
button.
|
||||
.VE
|
||||
.IP [2]
|
||||
When mouse button 1 is pressed over a checkbutton it is invoked (its
|
||||
When mouse button 1 is pressed over a checkbutton, it is invoked (its
|
||||
selection state toggles and the procedure associated with the button is
|
||||
invoked, if there is one).
|
||||
.VS
|
||||
.IP [3]
|
||||
When a checkbutton has the input focus, the space key causes the checkbutton
|
||||
to be invoked.
|
||||
to be invoked. Under Windows, there are additional key bindings; plus
|
||||
(+) and equal (=) select the button, and minus (-) deselects the button.
|
||||
.VE
|
||||
.PP
|
||||
If the checkbutton's state is \fBdisabled\fR then none of the above
|
||||
actions occur: the checkbutton is completely non-responsive.
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
'\" @(#) destroy.n 1.11 95/06/07 21:15:12
|
||||
'\"
|
||||
.so STk-man.macros
|
||||
.TH destroy n "4.1" Tk "Tk Built-In Commands"
|
||||
.TH destroy n "3.1" Tk "Tk Built-In Commands"
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
|
|
|
|||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue