honu-module -> honu; misc doc and slideshow tweaks
svn: r10230
This commit is contained in:
Matthew Flatt
parent
930650491f
commit
20fcb6314c
|
|
@ -1,157 +0,0 @@
|
|||
|
||||
>>> FOR NOW, THIS IS AN EXPERIMENTAL TOY <<<
|
||||
> Everything is subject to change. <
|
||||
|
||||
Honu is a "gradual-ly typed" language. That is, it's statically typed,
|
||||
but any expression can have type `obj', and an expresion of type `obj'
|
||||
is implicitly coreced to any other type by inserting run-time checks
|
||||
(with delayed checks for higher-order values, as in a contract
|
||||
system).
|
||||
|
||||
Every identifier binding has a declared type --- it's `obj' if an
|
||||
optional <type> is omitted --- and every function has a declared
|
||||
return type. Types for expressions are inferred in the obvious
|
||||
way. [TODO: explain "obvious".]
|
||||
|
||||
The syntax is much like Java, but also slightly influenced by
|
||||
Javascript, since functions are first-class values. Honu support
|
||||
higher-order parametric polymorphism, for which it uses the Java
|
||||
"generic" terminology.
|
||||
|
||||
There no no classes/records, yet. That's the next step.
|
||||
|
||||
|
||||
Write a Honu program as
|
||||
|
||||
#honu
|
||||
|
||||
<stmt|defn|impexp>
|
||||
...
|
||||
|
||||
and run it like a `(module ...)' program.
|
||||
|
||||
Each <stmt> as a top-level <stmt|defn> is implicitly wrapped to print
|
||||
the result of the <stmt> (if the result is not void).
|
||||
|
||||
The following grammar is a lie, because Honu is extensible in a way
|
||||
that doesn't fit BNFs. But it's (intended as) an accurate picture of
|
||||
the initial grammar before any extensions.
|
||||
|
||||
Types:
|
||||
|
||||
<type> := obj // anything
|
||||
| bool
|
||||
| int // exact integer
|
||||
| string // character string
|
||||
| (<type>* -> <type>) // procedure
|
||||
| (<id>* >-> <type>) // generic
|
||||
| <id> // if bound as generic argument
|
||||
|
||||
Definitions:
|
||||
|
||||
<defn> := var [<type>] <id> = <expr>; // <type> defaults to `obj'
|
||||
| const [<type>] <id> = <expr>; // prohibits assignment
|
||||
| <type> <id> = <expr>;
|
||||
| <type> id(<arg>,*) { <stmt|defn>* }
|
||||
| < <id>,* > <type> id(<arg>,*) { <stmt|defn>* }
|
||||
|
||||
<arg> := <id> // same as `obj <id>'
|
||||
| <type> <id>
|
||||
|
||||
The <defn> form is a generic-procedure definition.
|
||||
|
||||
Expressions:
|
||||
|
||||
<expr> := <literal>
|
||||
| <expr> <binop> <expr>
|
||||
| <unpreop> <expr>
|
||||
| <expr> <unpostop>
|
||||
| (<expr>)
|
||||
| { <stmt|defn>* }
|
||||
| (type)<expr> // cast
|
||||
| <expr>(<expr>,*) // procedure call
|
||||
| <expr> [ <expr> ] // array access (eventually)
|
||||
| <expr> < <type>,* > // generic instantiation
|
||||
| [type] function(<arg>,*) { <stmt|defn>* } // anon function
|
||||
| < <id>,* > [type] function(<arg>,*) { <stmt|defn>* }
|
||||
|
||||
<literal> := <number>
|
||||
| <string>
|
||||
| true | false
|
||||
|
||||
<binop> := + | - | * | / | %
|
||||
| == | < | > | >= | <= | =
|
||||
| && | ||
|
||||
| ? | : // see note below
|
||||
|
||||
Operators have the same precedence as in Java
|
||||
|
||||
Note: `<expr> ? <expr> : <expr>' is currently parsed as
|
||||
`(<expr> ? (<expr> : <expr>))', where `?' looks for
|
||||
`:' in its second argument.
|
||||
|
||||
Statements:
|
||||
|
||||
<stmt|defn> := <stmt>
|
||||
| <defn> // in non-tail positions, only
|
||||
|
||||
<stmt> := <expr> ;
|
||||
| if (<expr>) <branch>
|
||||
| if (<expr>) <branch> else <branch>
|
||||
| return <stmt> // in tail positions, only
|
||||
| time <expr> ;
|
||||
|
||||
<branch> := { <stmt>* }
|
||||
| <stmt>
|
||||
|
||||
Imports and exports:
|
||||
|
||||
<stmt|defn|impexp> := <stmt|defn>
|
||||
| provide <id>,* ;
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
About Honu Parsing and Typechecking
|
||||
-----------------------------------
|
||||
|
||||
A Honu program is first parsed by using the MzScheme reader, which
|
||||
goes into H-expression mode due to the leading #honu. This read phase
|
||||
tokenizes and groups based on parens, braces, brackets, and (under
|
||||
certain circumstances) angle brackets. See the MzScheme manual for
|
||||
details.
|
||||
|
||||
The program is then parsed, expanded (including translation to
|
||||
Scheme), and type-checked all at once. Thus, the parsing of a term can
|
||||
depend on the type assigned by the context.
|
||||
|
||||
Parsing proceeds by taking the first thing in the reader's output and
|
||||
checking whether it has a binding as a Honu transformer. For example
|
||||
`int' will have a binding to a transformer that expands the next bit
|
||||
of the stream to a variable or function definition. This transformer
|
||||
check is performed when the stream starts with an identifier or a
|
||||
parenthesized group (<h-expr> ...) includes only one operator
|
||||
identifier; in the latter case, the operator is used for looking up a
|
||||
transformer. For example, `(int -> int)' starts a definition because
|
||||
`->' is bound to a transformer.
|
||||
|
||||
A transformer takes the current stream and a context object; it
|
||||
returns a Scheme expression and the unconsumed part of the stream. The
|
||||
Scheme expression is likely to contain unparsed H-expression
|
||||
representations in a `honu-unparsed-block' form, which is bound to a
|
||||
Scheme macro in the usual way to continue parsing later.
|
||||
|
||||
A context object can be anything. The base Honu grammar implies
|
||||
several kinds of contexts, each with its own record type (described
|
||||
later). A transformer should expand only in contexts that it
|
||||
recognizes, and it should raise a syntax error when given any context
|
||||
that it doesn't recognize. A transformer might expand differently in
|
||||
different contexts. For example, `int' expands to a definition in a
|
||||
block context (e.g., at the top level), but to a type description in a
|
||||
type context (e.g., in a procedure's formal argument list).
|
||||
|
||||
When the start of the stream offers no other guidance, it is parsed as
|
||||
an expression. The expression-parsing rules are essentially hardwired
|
||||
to the Java grammar rules. (In the future, programmers will likely
|
||||
have control over precedence, at least.)
|
||||
|
||||
[to be continued]
|
||||
16
collects/honu/lang/reader.ss
Normal file
16
collects/honu/lang/reader.ss
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
|
||||
(module reader scheme/base
|
||||
(require (only-in syntax/module-reader wrap-read-all))
|
||||
(provide (rename-out [*read read]
|
||||
[*read-syntax read-syntax]))
|
||||
|
||||
(define (*read in modpath line col pos)
|
||||
(wrap in read-honu modpath #f line col pos))
|
||||
|
||||
(define (*read-syntax src in modpath line col pos)
|
||||
(wrap in (lambda (in)
|
||||
(read-honu-syntax src in))
|
||||
modpath src line col pos))
|
||||
|
||||
(define (wrap port read modpath src line col pos)
|
||||
(wrap-read-all 'honu port read modpath src line col pos)))
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
(module honu-module "private/mzscheme.ss"
|
||||
(module main "private/mzscheme.ss"
|
||||
|
||||
(require-for-syntax syntax/stx
|
||||
"private/ops.ss"
|
||||
|
|
@ -767,7 +767,7 @@
|
|||
(define-syntax arg-id (make-honu-type #'arg-pred-id stx-car #'arg-name-id #f)) ...
|
||||
(honu-unparsed-type-predicate #,>->-stx next-pred res-type-name . #,result-stx)
|
||||
(let ([v ((generic-val v) safe? arg-pred-id ... arg-name-id ...)])
|
||||
(check #f #f res-type-name next-pred v)))))
|
||||
(check* #f #f res-type-name next-pred v)))))
|
||||
;; Not a generic
|
||||
(values #f #f)))
|
||||
;; generics always protect themselves, for now:
|
||||
|
|
@ -927,17 +927,17 @@
|
|||
(define (check proc who type-name pred val)
|
||||
(let-values ([(tst new-val) (pred val)])
|
||||
(unless tst
|
||||
(raise
|
||||
(make-exn:fail:contract
|
||||
(format "~a: expected `~a' value for ~a, got something else: ~e"
|
||||
(raise
|
||||
(make-exn:fail:contract
|
||||
(format "~a: expected `~a' value for ~a, got something else: ~e"
|
||||
(or proc (if (eq? who #t) #f who) "procedure")
|
||||
type-name
|
||||
(cond [(eq? who #t) "result"]
|
||||
[else (if proc
|
||||
(format "`~a' argument" who)
|
||||
(if who "initialization" "argument"))])
|
||||
(format "`~a' argument" who)
|
||||
(if who "initialization" "argument"))])
|
||||
val)
|
||||
(current-continuation-marks))))
|
||||
(current-continuation-marks))))
|
||||
new-val))
|
||||
|
||||
(define-syntax as-protected
|
||||
|
|
@ -1017,7 +1017,7 @@
|
|||
v))
|
||||
;; Need a run-time check:
|
||||
(with-syntax ([val v])
|
||||
#'(check proc who type-name-expr pred val))))]
|
||||
#'(check* proc who type-name-expr pred val))))]
|
||||
[(if test-expr then-expr else-expr)
|
||||
(if (eq? #t (syntax-e #'type-name))
|
||||
;; Context guarantees correct use, but we have to manage any
|
||||
|
|
@ -1086,7 +1086,13 @@
|
|||
v
|
||||
;; Run-time check:
|
||||
(with-syntax ([val v])
|
||||
#'(check proc who type-name-expr pred val))))]))]))
|
||||
#'(check* proc who type-name-expr pred val))))]))]))
|
||||
|
||||
(define-syntax check*
|
||||
(syntax-rules ()
|
||||
[(_ proc who type-name #f val) val]
|
||||
[(_ proc who type-name pred val)
|
||||
(check proc who type-name pred val)]))
|
||||
|
||||
(define-syntax (honu-app stx)
|
||||
(syntax-case stx ()
|
||||
|
|
@ -1099,9 +1105,13 @@
|
|||
(if (= (length (syntax->list #'(arg-type ...)))
|
||||
(length (syntax->list #'(b ...))))
|
||||
;; Some run-time checks maybe needed on some arguments:
|
||||
#'(honu-typed (pack-a-expr (check-expr-type #f #f arg-type arg-type-name arg-pred b) ...)
|
||||
orig-expr
|
||||
result-type result-protect-id)
|
||||
(with-syntax ([app
|
||||
(syntax/loc stx
|
||||
(pack-a-expr (check-expr-type #f #f arg-type arg-type-name arg-pred b) ...))])
|
||||
(syntax/loc stx
|
||||
(honu-typed app
|
||||
orig-expr
|
||||
result-type result-protect-id)))
|
||||
(raise-syntax-error #f
|
||||
(format (string-append
|
||||
"static type mismatch: "
|
||||
|
|
@ -1114,7 +1124,8 @@
|
|||
;; There will be a run-time check to make sure that a is the
|
||||
;; right kind of function, etc., and it will take care of the
|
||||
;; argument checks itself.
|
||||
#'(#%app (honu-typed pack-a-expr orig-a-expr a-type a-protect-id) b ...)]
|
||||
(syntax/loc stx
|
||||
(#%app (honu-typed pack-a-expr orig-a-expr a-type a-protect-id) b ...))]
|
||||
[_else
|
||||
(type-mismatch #'orig-a-expr #'a-type #'(-> (.... #f) (.... #f #f)))]))]))
|
||||
|
||||
|
|
@ -1178,11 +1189,14 @@
|
|||
[(set! id rhs)
|
||||
(if const?
|
||||
(raise-syntax-error #f "cannot assign to constant" #'id)
|
||||
#'(set! gen-id (check-expr-type 'set! id type-name type-name-expr pred-id rhs)))]
|
||||
(syntax/loc stx
|
||||
(set! gen-id (check-expr-type 'set! id type-name type-name-expr pred-id rhs))))]
|
||||
[(id arg (... ...))
|
||||
#'(honu-app (honu-typed gen-id id type-name protect-id) arg (... ...))]
|
||||
(syntax/loc stx
|
||||
(honu-app (honu-typed gen-id id type-name protect-id) arg (... ...)))]
|
||||
[id
|
||||
#'(honu-typed gen-id id type-name protect-id)]))))))]))
|
||||
(syntax/loc stx
|
||||
(honu-typed gen-id id type-name protect-id))]))))))]))
|
||||
|
||||
(define-for-syntax (make-typed-procedure gen-id result-spec arg-spec protect-id)
|
||||
(with-syntax ([((arg arg-type arg-type-name arg-pred-id) ...) arg-spec]
|
||||
|
|
@ -251,7 +251,9 @@
|
|||
[(define-values-for-syntax . _)
|
||||
#`(begin #,e2 (frm e1s e3s def-ids))]
|
||||
[(begin b1 ...)
|
||||
#`(frm e1s (b1 ... . e3s) def-ids)]
|
||||
(syntax-track-origin #`(frm e1s (b1 ... . e3s) def-ids)
|
||||
e2
|
||||
(car (syntax-e e2)))]
|
||||
[(define-values (id ...) . _)
|
||||
#`(frm (#,e2 . e1s) e3s (id ... . def-ids))]
|
||||
[_
|
||||
|
|
|
|||
|
|
@ -459,10 +459,13 @@
|
|||
stx
|
||||
(define name
|
||||
#,(stepper-syntax-property
|
||||
#`(lambda arg-seq
|
||||
#,(stepper-syntax-property #`make-lambda-generative
|
||||
'stepper-skip-completely #t)
|
||||
lexpr ...)
|
||||
(syntax-track-origin
|
||||
#`(lambda arg-seq
|
||||
#,(stepper-syntax-property #`make-lambda-generative
|
||||
'stepper-skip-completely #t)
|
||||
lexpr ...)
|
||||
lam
|
||||
(syntax-local-introduce (car (syntax-e lam))))
|
||||
'stepper-define-type
|
||||
'lambda-define))))))])
|
||||
(check-definition-new
|
||||
|
|
|
|||
|
|
@ -1,6 +1,5 @@
|
|||
#lang scribble/doc
|
||||
@(require (for-label scheme/base
|
||||
scheme/contract
|
||||
@(require (for-label (except-in lazy delay force promise?)
|
||||
(only-in lazy/force
|
||||
! !! !!!
|
||||
!list !!list
|
||||
|
|
@ -17,6 +16,32 @@
|
|||
(define scheme-promise? (scheme promise?))))
|
||||
(def-scheme scheme-force scheme-delay scheme-promise?))
|
||||
|
||||
@(define-syntax-rule (deflazy mod def id)
|
||||
(begin
|
||||
(def-mz-req mod id mz-id)
|
||||
@def[id]{Lazy variant of @|mz-id|.}))
|
||||
|
||||
@(define-syntax-rule (def-mz-req mod id in-mz-id)
|
||||
(begin
|
||||
(define-syntax-rule (intro mz-id)
|
||||
(begin
|
||||
(require (for-label (only-in mod id)))
|
||||
(define mz-id (scheme id))))
|
||||
(intro in-mz-id)))
|
||||
|
||||
@(define-syntax-rule (defprocthing* mod id ...)
|
||||
(begin
|
||||
(deflazy mod defprocthing id)
|
||||
...))
|
||||
|
||||
@(define-syntax-rule (defprocthing id . rest)
|
||||
(defthing id procedure? . rest))
|
||||
|
||||
@(define-syntax-rule (defidform* mod id ...)
|
||||
(begin
|
||||
(deflazy mod defidform id)
|
||||
...))
|
||||
|
||||
@; ----------------------------------------
|
||||
|
||||
@(require scribble/manual)
|
||||
|
|
@ -31,7 +56,7 @@ can be used to write lazy code. To write lazy code, simply use
|
|||
|
||||
@schememod[
|
||||
lazy
|
||||
... lazy code here...]
|
||||
... #, @elem{lazy code here}...]
|
||||
|
||||
Function applications are delayed, and promises are automatically
|
||||
forced. The language provides bindings that are equivalent to most of
|
||||
|
|
@ -61,11 +86,60 @@ change (or be dropped) in the future.
|
|||
|
||||
There are a few additional bindings, the important ones are special
|
||||
forms that force strict behaviour---there are several of these that
|
||||
are useful in forcing different parts of a value in different ways.
|
||||
are useful in forcing different parts of a value in different ways, as
|
||||
described in @secref["forcing"].
|
||||
|
||||
@; ----------------------------------------
|
||||
|
||||
@section{Forcing Values}
|
||||
@section{Lazy Forms and Functions}
|
||||
|
||||
@defidform*[mzscheme
|
||||
lambda
|
||||
define
|
||||
]
|
||||
|
||||
@defidform*[scheme
|
||||
let
|
||||
let*
|
||||
letrec
|
||||
parameterize
|
||||
define-values
|
||||
let-values
|
||||
let*-values
|
||||
letrec-values
|
||||
if
|
||||
set!
|
||||
begin begin0 when unless
|
||||
cond case
|
||||
]
|
||||
|
||||
@defprocthing*[scheme
|
||||
values make-struct-type
|
||||
cons list list* vector box
|
||||
and or
|
||||
set-mcar! set-mcdr! vector-set! set-box!
|
||||
error printf fprintf display write print
|
||||
eq? eqv? equal?
|
||||
list? length list-ref list-tail append map for-each andmap ormap
|
||||
member memq memv assoc assq assv reverse
|
||||
caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar
|
||||
caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr
|
||||
cddaar cddadr cdddar cddddr
|
||||
first second third fourth fifth sixth seventh eighth rest cons? empty empty?
|
||||
foldl foldr last-pair remove remq remv remove* remq* remv* memf assf filter
|
||||
sort
|
||||
true false boolean=? symbol=? compose build-list
|
||||
take
|
||||
]
|
||||
|
||||
@defprocthing[identity]{Lazy identity function.}
|
||||
|
||||
@defprocthing[cycle]{Creates a lazy infinite list given a list of
|
||||
elements to repeat in order.}
|
||||
|
||||
@; ----------------------------------------
|
||||
|
||||
@section[#:tag "forcing"]{Forcing Values}
|
||||
|
||||
@defmodule[lazy/force]
|
||||
|
||||
|
|
|
|||
|
|
@ -264,8 +264,8 @@ Returns the file or directory's last modification date as
|
|||
platform-specific seconds (see also @secref["time"]) when
|
||||
@scheme[secs-n] is not provided or is @scheme[#f]. (For FAT
|
||||
filesystems under Windows, directories do not have modification
|
||||
dates. Therefore, the creation date is returned for a directory (but
|
||||
the modification date is returned for a file).)
|
||||
dates. Therefore, the creation date is returned for a directory, but
|
||||
the modification date is returned for a file.)
|
||||
|
||||
If @scheme[secs-n] is provided and not @scheme[#f], the access and
|
||||
modification times of @scheme[path] are set to the given time.
|
||||
|
|
|
|||
|
|
@ -248,8 +248,8 @@ pre-defined forms are as follows.
|
|||
@defsubform[(only-in require-spec id-maybe-renamed ...)]{
|
||||
Like @scheme[require-spec], but constrained to those exports for
|
||||
which the identifiers to bind match @scheme[id-maybe-renamed]: as
|
||||
@scheme[id] or as @scheme[orig-id] in @scheme[[orig-id bind-id]]. If
|
||||
the @scheme[id] of @scheme[orig-id] of any @scheme[id-maybe-renamed]
|
||||
@scheme[_id] or as @scheme[_orig-id] in @scheme[[_orig-id _bind-id]]. If
|
||||
the @scheme[_id] or @scheme[_orig-id] of any @scheme[id-maybe-renamed]
|
||||
is not in the set that @scheme[require-spec] describes, a syntax
|
||||
error is reported.}
|
||||
|
||||
|
|
|
|||
|
|
@ -681,7 +681,7 @@ library provides functions for creating and placing cartoon-speech
|
|||
balloons.}
|
||||
|
||||
@defproc[(wrap-balloon [pict pict?]
|
||||
[spike one-of/c ('n 's 'e 'w 'ne 'se 'sw 'nw)]
|
||||
[spike (one-of/c ('n 's 'e 'w 'ne 'se 'sw 'nw))]
|
||||
[dx real?]
|
||||
[dy real?]
|
||||
[color (or/c string? (is-a?/c color%)) balloon-color]
|
||||
|
|
@ -810,8 +810,8 @@ follows:
|
|||
}}
|
||||
|
||||
@defproc[(face* [eyebrow-kind (one-of/c 'none 'normal 'worried 'angry)]
|
||||
[mouth-kind (one-of/c 'plain 'narrow 'medium 'large 'huge
|
||||
'grimace 'oh 'tongue)]
|
||||
[mouth-kind (one-of/c 'plain 'smaller 'narrow 'medium 'large
|
||||
'huge 'grimace 'oh 'tongue)]
|
||||
[frown? any/c]
|
||||
[color (or/c string (is-a?/c color%))]
|
||||
[eye-inset real?]
|
||||
|
|
@ -832,7 +832,7 @@ Returns a pict for a face:
|
|||
|
||||
@item{@scheme[eyebrow-kind] determines the eyebrow shape.}
|
||||
|
||||
@item{@scheme[mouth-kind] determines the mouth shape, sombined with
|
||||
@item{@scheme[mouth-kind] determines the mouth shape, combined with
|
||||
@scheme[frown?].}
|
||||
|
||||
@item{@scheme[frown?] determines whether the mouth is up or down.}
|
||||
|
|
|
|||
|
|
@ -99,7 +99,11 @@
|
|||
(define (record-error cc desc go fail-k)
|
||||
(with-handlers ([exn:fail?
|
||||
(lambda (x)
|
||||
(fprintf (current-error-port) "~a\n" (exn->string x))
|
||||
(if (verbose)
|
||||
((error-display-handler)
|
||||
(format "~a\n" (exn->string x))
|
||||
x)
|
||||
(fprintf (current-error-port) "~a\n" (exn->string x)))
|
||||
(set! errors (cons (list cc desc x) errors))
|
||||
(fail-k))])
|
||||
(go)))
|
||||
|
|
|
|||
|
|
@ -107,15 +107,16 @@
|
|||
(* sw 2/3) (+ (if flip? 0 i) (* h 2/3))
|
||||
(- (* pi (- 5/4 (if flip? 1 0))) da) (+ (* pi (- 7/4 (if flip? 1 0))) da)))
|
||||
|
||||
(define (plain-smile flip? tongue?)
|
||||
(define (plain-smile flip? tongue? narrow?)
|
||||
(send dc set-brush no-brush)
|
||||
(series dc
|
||||
(if mouth-shading? 3 0)
|
||||
(make-object color% "black")
|
||||
face-edge-color
|
||||
(lambda (i)
|
||||
(smile w h i 0 #f 0 flip?)
|
||||
(smile w h (+ 1 (- i)) 0 #f 0 flip?))
|
||||
(let ([da (if narrow? (* pi -1/8) 0)])
|
||||
(smile w h i da #f 0 flip?)
|
||||
(smile w h (+ 1 (- i)) da #f 0 flip?)))
|
||||
#t #f)
|
||||
(when tongue?
|
||||
(let ([path (new dc-path%)]
|
||||
|
|
@ -243,7 +244,12 @@
|
|||
|
||||
(define (medium-grimace flip?)
|
||||
(grimace
|
||||
(* 1.2 w) (* h 0.9) (- (* 0.1 pi))
|
||||
(* 1.2 w) (* h 0.9) (- (* 0.1 pi))
|
||||
flip?))
|
||||
|
||||
(define (narrow-grimace flip?)
|
||||
(grimace
|
||||
(* 1.2 w) (* h 0.9) (- (* 0.1 pi)) 15
|
||||
flip?))
|
||||
|
||||
(define (large-smile flip?)
|
||||
|
|
@ -327,14 +333,15 @@
|
|||
[(angry) (angry-eyebrows eyebrow-dy)]
|
||||
[(none) (void)])
|
||||
(case mouth-kind
|
||||
[(plain) (plain-smile frown? #f)]
|
||||
[(plain) (plain-smile frown? #f #f)]
|
||||
[(smaller) (plain-smile frown? #f #t)]
|
||||
[(narrow) (narrow-smile frown?)]
|
||||
[(medium) (medium-smile frown?)]
|
||||
[(large) (large-smile frown?)]
|
||||
[(huge) (largest-smile frown?)]
|
||||
[(grimace) (medium-grimace frown?)]
|
||||
[(oh) (oh)]
|
||||
[(tongue) (plain-smile frown? #t)])
|
||||
[(tongue) (plain-smile frown? #t #f)])
|
||||
|
||||
(send dc set-brush old-brush)
|
||||
(send dc set-pen old-pen))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user