diff --git a/collects/htdp/Test/graphing2.ss b/collects/htdp/Test/graphing2.ss deleted file mode 100644 index a2039bbd75..0000000000 --- a/collects/htdp/Test/graphing2.ss +++ /dev/null @@ -1,17 +0,0 @@ -;; TeachPack: graphing2.ss -;; Language: Beginner - -;; ------------------------------------------------------------------------ - -(define (fun1 x) (+ (* x x) 1)) -(graph-fun fun1 'red) - -(define (fun2 x) (+ (* -1 x x) 1)) -(graph-fun fun2 'blue) - -(define (line1 x) (* +1 x)) -(graph-line line1 'black) - -(define (line2 x) (* -1 x)) -(graph-line line2 'green) - diff --git a/collects/htdp/Test/hangman1.ss b/collects/htdp/Test/hangman1.ss index 18a4f619fd..bf1f486c95 100644 --- a/collects/htdp/Test/hangman1.ss +++ b/collects/htdp/Test/hangman1.ss @@ -47,13 +47,17 @@ (make-word '_ '_ '_)) ;; check errors +#; (check-error (hangman make-word) "hangman: primitive operator requires 3 arguments") +#; (check-error (hangman (make-word 'a 'b 'c) reveal draw-next-part) "hangman: primitive operator hangman expects a defined procedure name (usually `make-word') in this position") +#; (check-error (hangman make-word (reveal (make-word 'd 'e 'r) (make-word '_ '_ '_) 'd) draw-next-part) "hangman: primitive operator hangman expects a defined procedure name (usually `reveal') in this position") +#; (check-error (hangman make-word reveal 100) "hangman: primitive operator hangman expects a defined procedure name (usually `draw-next') in this position") diff --git a/collects/htdp/Test/master-play.ss b/collects/htdp/Test/master-play.ss deleted file mode 100644 index a63a8ec82f..0000000000 --- a/collects/htdp/Test/master-play.ss +++ /dev/null @@ -1,43 +0,0 @@ -;; The first three lines of this file were inserted by DrScheme. They record metadata -;; about the language level of this file in a form that our tools can easily process. -#reader(lib "htdp-beginner-reader.ss" "lang")((modname master-play) (read-case-sensitive #t) (teachpacks ((lib "guess-gui.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "guess-gui.ss" "teachpack" "htdp"))))) -(define-signature masterTS (go)) - -(define (masterT N) - (unit/sig masterTS (import (m : masterS) plt:userspace^) - ;; check-guess-two : sym sym sym sym -> sym - ;; to determine whether targetI and guessI are the same - ;; or whether at least some of guessI occur in targetI - (define (check-guess-two target1 target2 guess1 guess2) - (cond - ((and (eq? target1 guess1) (eq? target2 guess2)) - 'perfect_guess) - ((or (eq? target1 guess1) (eq? target2 guess2)) - 'one_color_at_correct_position) - ((or (eq? target2 guess1) (eq? target1 guess2)) - 'the_colors_occur) - (else 'nothing_correct))) - - ;; check-guess-multiple : (listof sym) (listof sym) -> sym - ;; to determine whether guesses and choices are the same - ;; or whether at least some of guesses occur in choices - (define (check-guess-multiple choices guesses) - (cond - ((equal? choices guesses) 'perfect_guess) - (else (let* ((same-position (filter identity (map eq? choices guesses))) - (common (filter (lambda (x) (memq x choices)) guesses))) - (cond - ((pair? same-position) 'some_colors_are_in_proper_position) - ((pair? common) 'some_colors_occur_in_chosen_sequence) - (else 'all_wrong)))))) - - (define (go) - (m:repl (if (= N 2) check-guess-two check-guess-multiple))))) - -(compound-unit/sig (import (PLT : plt:userspace^)) - (link - (TEST : masterTS ((masterT 3) MASTER PLT)) - (MASTER : masterS ((masterU 3) ERR PLT)) - (ERR : errorS (errorU))) - (export (open TEST))) - diff --git a/collects/htdp/Test/rectangle.ss b/collects/htdp/Test/rectangle.ss deleted file mode 100644 index b7f81246be..0000000000 --- a/collects/htdp/Test/rectangle.ss +++ /dev/null @@ -1,12 +0,0 @@ -;; TeachPack: rectangle.ss -;; LanguageLevel: beginner - -(start 100 100) - -(show (list - (list RED RED))) - -(show (list - (list BLUE BLUE BLUE BLUE) - (list GREEN RED RED GREEN) - (list BLUE BLUE BLUE BLUE))) diff --git a/collects/htdp/Test/world-add-line.ss b/collects/htdp/Test/world-add-line.ss index cf36121b78..a05a519f50 100644 --- a/collects/htdp/Test/world-add-line.ss +++ b/collects/htdp/Test/world-add-line.ss @@ -1,8 +1,8 @@ ;; The first three lines of this file were inserted by DrScheme. They record metadata ;; about the language level of this file in a form that our tools can easily process. -#reader(lib "htdp-beginner-reader.ss" "lang")((modname world-add-line) (read-case-sensitive #t) (teachpacks ((lib "world.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "world.ss" "teachpack" "htdp"))))) +#reader(lib "htdp-beginner-reader.ss" "lang")((modname world-add-line) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) (require (lib "world.ss" "htdp")) -;(require htdp/world) +; (require 2htdp/universe) (define plain (empty-scene 100 100)) diff --git a/collects/htdp/Test/world.ss b/collects/htdp/Test/world.ss index 6315d906b1..0808543413 100644 --- a/collects/htdp/Test/world.ss +++ b/collects/htdp/Test/world.ss @@ -1,6 +1,8 @@ ;; The first three lines of this file were inserted by DrScheme. They record metadata ;; about the language level of this file in a form that our tools can easily process. -#reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname world) (read-case-sensitive #t) (teachpacks ((lib "universe.ss" "teachpack" "2htdp") (lib "foo.ss" "installed-teachpacks"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "universe.ss" "teachpack" "2htdp") (lib "foo.ss" "installed-teachpacks"))))) +#reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname world) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) +(require 2htdp/universe) + ;; testing world ;; World = Nat @@ -19,23 +21,20 @@ [else w])) ;; --- -(check-expect (key-event? 'a) true) +(check-expect (key-event? 'a) false) (check-expect (key-event? 0) false) -(check-expect (key-event? #\a) true) +(check-expect (key-event? "a") true) -(check-expect (key=? 'a 'b) false) -(check-expect (key=? 'a #\a) false) -(check-expect (key=? 'left 'left) true) +(check-expect (key=? "b" "a") false) -(check-error (key=? 'a 0) "key=?: expected as second argument, given: 0") +(check-error (key=? "a" 0) "key=?: expected as second argument, given: 0") ;; run world run -xxx - -(big-bang world0 - (on-draw world->image) - (on-tick world->next) - (on-key world->steer) - (stop-when zero?)) +(define (main world0) + (big-bang world0 + (on-draw world->image) + (on-tick world->next) + (on-key world->steer) + (stop-when zero?)))