Uso de objetos en dr scheme

Solo disponible en BuenasTareas
  • Páginas : 5 (1187 palabras )
  • Descarga(s) : 0
  • Publicado : 23 de julio de 2010
Leer documento completo
Vista previa del texto
;; Ejemplo de objeto choice%
(define G '("" "A" "B" "C" "D" "E" "F" "G" "H"))
(define L '(( "Uruguay" "Mexico" "Francia" "Sudafrica")
("Argentina" "Corea del Sur" "Grecia" "Nigeria")
("Eslovenia" "Estados Unidos" "Inglaterra" "Argelia")
("Ghana" "Alemania" "Serbia" "Australia")
("Holanda" "Japón" "Dinamarca" "Camerún")("Paraguay" "Italia" "Nueva Zelanda" "Eslovaquia")
("Brasil" "Portugal" "Costa de Marfil" "Rep. Korea")
("Chile" "Suiza" "Honduras" "España")))


(define ppal (new frame% (label "Posiciones Mundial 2010")
(width 300)(height 200)(border 20)))
(define grupos (new choice% (label "Grupos") (parent ppal)
(choices G)(vert-margin 10)(horiz-margin10)
(callback (lambda (choice event)
(cond ((string=? (send grupos get-string-selection) "")
(send equipos set '()))
(else
(send equipos set (list-ref L (- (send grupos get-selection) 1)))))))))
(define equipos (new list-box% (label "Equipos")(parent ppal)(choices '())(vert-margin 10)(horiz-margin 10)))

(define btn (new button% (label "&Salir")(parent ppal)
(style '(border))(min-width 100)
(callback (lambda (button event)
(send ppal show #f)))))
(send ppal show #t)
(sleep/yield 1);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Ejemplo de objeto text-field%

(define Lista '())
(define E "El conjunto es: ")

(define (crearCadena L)
(crearCadenaAux L "{"))
(define (crearCadenaAux L cad)
(if (null? L)
(string-append cad "}")
(crearCadenaAux (cdr L) (string-append cad (number->string (car L)) (if (not (null? (cdr L))) ", " " ")))))

(define (insertar item L)(cond ((null? L) (list item))
((< item (car L)) (cons item L))
(else (cons (car L)(insertar item (cdr L))))))
(define (eliminar item L)
(if (equal? item (car L)) (cdr L) (cons (car L)(eliminar item (cdr L)))))
(define (buscar? item L)
(cond ((null? L) #f)
(else (or (equal? item (car L)) (buscar? item (cdr L))))))


(define principal (new dialog% (label "Miprimer programa") (width 400)(height 60)))
(define ft (make-object font% 16 'roman 'normal 'bold))
;;(send ft set-size 14)
(define titulo (new message% (label "MANEJO DE CONJUNTOS")(parent principal)
(font ft)(vert-margin 10)(horiz-margin 20)))

(define Item (new text-field% (label "Ingrese el valor delitem: ") (parent principal) (init-value "")
(vert-margin 10)(horiz-margin 250)(min-width 140)(min-height 20)))
(define conjunto (new text-field% (label E)(parent principal)(init-value (crearCadena Lista))
(min-width 380)(min-height 80)(style '(multiple))(vert-margin 5)))
(define mess2 (new message% (label "") (parent principal)(min-width 380)(vert-margin10)))
(define botones (new horizontal-pane% (parent principal)(alignment '(center bottom))(vert-margin 5)(min-width 290)))
(define Add (new button% (label "Agregar") (parent botones)(vert-margin 10)(min-width 80)
;;
(callback (lambda (button event)
(if (string->number (send Item get-value) 10)
(begin(set! Lista (insertar (string->number (send Item get-value) 10) Lista))
(send conjunto set-value (crearCadena Lista))
(send mess2 set-label ""))
(send mess2 set-label "El valor ingresado no es numero"))))))
(define Del (new button% (label "Suprimir")(parent...
tracking img