├── .github └── workflows │ └── ci.yml ├── .gitignore ├── LICENSE ├── README.md ├── htdp-doc ├── LICENSE ├── graphics │ └── scribblings │ │ ├── common.rkt │ │ ├── graphics.scrbl │ │ ├── info.rkt │ │ ├── traditional-turtles.scrbl │ │ ├── turtles.scrbl │ │ └── value-turtles.scrbl ├── htdp │ ├── error-composition.scrbl │ ├── error-reporting.scrbl │ ├── htdp-lib.scrbl │ ├── htdp.scrbl │ ├── info.rkt │ └── testing.scrbl ├── info.rkt ├── scribblings │ └── htdp-langs │ │ ├── advanced.scrbl │ │ ├── beginner-abbr.scrbl │ │ ├── beginner.scrbl │ │ ├── common.rkt │ │ ├── htdp-langs.scrbl │ │ ├── htdp-ptr.scrbl │ │ ├── info.rkt │ │ ├── intermediate-lambda.scrbl │ │ ├── intermediate.scrbl │ │ ├── prim-ops.rkt │ │ └── std-grammar.rkt ├── stepper │ ├── info.rkt │ └── scribblings │ │ └── stepper.scrbl ├── teachpack │ ├── 2htdp │ │ └── scribblings │ │ │ ├── 2htdp.scrbl │ │ │ ├── PlanetCuteShadow1.png │ │ │ ├── PlanetCuteShadow2.png │ │ │ ├── PlanetCuteShadow2b.png │ │ │ ├── PlanetCuteShadow3.png │ │ │ ├── PlanetCuteShadowMockup.jpg │ │ │ ├── abstraction.scrbl │ │ │ ├── batch-io.scrbl │ │ │ ├── data-plain.xml │ │ │ ├── data.csv │ │ │ ├── data.txt │ │ │ ├── data.xml │ │ │ ├── image-guide.scrbl │ │ │ ├── image-util.rkt │ │ │ ├── image.scrbl │ │ │ ├── info.rkt │ │ │ ├── io.css │ │ │ ├── io.tex │ │ │ ├── itunes.scrbl │ │ │ ├── ligature.png │ │ │ ├── planetcute.scrbl │ │ │ ├── port.rkt │ │ │ ├── port.scrbl │ │ │ ├── shared.rkt │ │ │ ├── universe.scrbl │ │ │ └── web-io.scrbl │ ├── balls.png │ ├── door-real.png │ ├── door-sim.png │ ├── gamepad.png │ ├── htdp │ │ └── scribblings │ │ │ ├── arrow-gui.scrbl │ │ │ ├── arrow.scrbl │ │ │ ├── convert.scrbl │ │ │ ├── dir.scrbl │ │ │ ├── docs.scrbl │ │ │ ├── draw.scrbl │ │ │ ├── elevator.scrbl │ │ │ ├── graphing.scrbl │ │ │ ├── guess-gui.scrbl │ │ │ ├── guess.scrbl │ │ │ ├── gui.scrbl │ │ │ ├── hangman-play.scrbl │ │ │ ├── hangman.scrbl │ │ │ ├── htdp.scrbl │ │ │ ├── image.scrbl │ │ │ ├── lkup-gui.scrbl │ │ │ ├── master-play.scrbl │ │ │ ├── master.scrbl │ │ │ ├── matrix.scrbl │ │ │ ├── servlet.thtml │ │ │ ├── servlet2.thtml │ │ │ ├── shared.rkt │ │ │ ├── show-queen.scrbl │ │ │ └── world.scrbl │ ├── info.rkt │ ├── nuworld.png │ ├── server.png │ ├── teachpack.scrbl │ ├── triangle-xxx.png │ ├── universe.png │ └── world.png └── test-engine │ ├── info.rkt │ └── test-engine.scrbl ├── htdp-lib ├── 2htdp │ ├── abstraction.rkt │ ├── batch-io.rkt │ ├── image.rkt │ ├── info.rkt │ ├── itunes.rkt │ ├── langs.txt │ ├── planetcute.rkt │ ├── planetcute │ │ ├── brown-block.png │ │ ├── brown-block.rkt │ │ ├── character-boy.png │ │ ├── character-boy.rkt │ │ ├── character-cat-girl.png │ │ ├── character-cat-girl.rkt │ │ ├── character-horn-girl.png │ │ ├── character-horn-girl.rkt │ │ ├── character-pink-girl.png │ │ ├── character-pink-girl.rkt │ │ ├── character-princess-girl.png │ │ ├── character-princess-girl.rkt │ │ ├── chest-closed.png │ │ ├── chest-closed.rkt │ │ ├── chest-lid.png │ │ ├── chest-lid.rkt │ │ ├── chest-open.png │ │ ├── chest-open.rkt │ │ ├── dirt-block.png │ │ ├── dirt-block.rkt │ │ ├── door-tall-closed.png │ │ ├── door-tall-closed.rkt │ │ ├── door-tall-open.png │ │ ├── door-tall-open.rkt │ │ ├── enemy-bug.png │ │ ├── enemy-bug.rkt │ │ ├── gem-blue.png │ │ ├── gem-blue.rkt │ │ ├── gem-green.png │ │ ├── gem-green.rkt │ │ ├── gem-orange.png │ │ ├── gem-orange.rkt │ │ ├── grass-block.png │ │ ├── grass-block.rkt │ │ ├── heart.png │ │ ├── heart.rkt │ │ ├── key.png │ │ ├── key.rkt │ │ ├── plain-block.png │ │ ├── plain-block.rkt │ │ ├── ramp-east.png │ │ ├── ramp-east.rkt │ │ ├── ramp-north.png │ │ ├── ramp-north.rkt │ │ ├── ramp-south.png │ │ ├── ramp-south.rkt │ │ ├── ramp-west.png │ │ ├── ramp-west.rkt │ │ ├── rock.png │ │ ├── rock.rkt │ │ ├── roof-east.png │ │ ├── roof-east.rkt │ │ ├── roof-north-east.png │ │ ├── roof-north-east.rkt │ │ ├── roof-north-west.png │ │ ├── roof-north-west.rkt │ │ ├── roof-north.png │ │ ├── roof-north.rkt │ │ ├── roof-south-east.png │ │ ├── roof-south-east.rkt │ │ ├── roof-south-west.png │ │ ├── roof-south-west.rkt │ │ ├── roof-south.png │ │ ├── roof-south.rkt │ │ ├── roof-west.png │ │ ├── roof-west.rkt │ │ ├── selector.png │ │ ├── selector.rkt │ │ ├── shadow-east.png │ │ ├── shadow-east.rkt │ │ ├── shadow-north-east.png │ │ ├── shadow-north-east.rkt │ │ ├── shadow-north-west.png │ │ ├── shadow-north-west.rkt │ │ ├── shadow-north.png │ │ ├── shadow-north.rkt │ │ ├── shadow-side-west.png │ │ ├── shadow-side-west.rkt │ │ ├── shadow-south-east.png │ │ ├── shadow-south-east.rkt │ │ ├── shadow-south-west.png │ │ ├── shadow-south-west.rkt │ │ ├── shadow-south.png │ │ ├── shadow-south.rkt │ │ ├── shadow-west.png │ │ ├── shadow-west.rkt │ │ ├── speech-bubble.png │ │ ├── speech-bubble.rkt │ │ ├── stone-block-tall.png │ │ ├── stone-block-tall.rkt │ │ ├── stone-block.png │ │ ├── stone-block.rkt │ │ ├── tree-short.png │ │ ├── tree-short.rkt │ │ ├── tree-tall.png │ │ ├── tree-tall.rkt │ │ ├── tree-ugly.png │ │ ├── tree-ugly.rkt │ │ ├── wall-block-tall.png │ │ ├── wall-block-tall.rkt │ │ ├── wall-block.png │ │ ├── wall-block.rkt │ │ ├── water-block.png │ │ ├── water-block.rkt │ │ ├── window-tall.png │ │ ├── window-tall.rkt │ │ ├── wood-block.png │ │ ├── wood-block.rkt │ │ ├── yellow-star.png │ │ └── yellow-star.rkt │ ├── private │ │ ├── check-aux.rkt │ │ ├── checked-cell.rkt │ │ ├── clauses-spec-and-process.rkt │ │ ├── clauses-spec-aux.rkt │ │ ├── csv │ │ │ ├── csv.rkt │ │ │ ├── friends.csv │ │ │ ├── fruit.csv │ │ │ └── permission.txt │ │ ├── define-keywords.rkt │ │ ├── design.txt │ │ ├── gamepad.png │ │ ├── image-core.rkt │ │ ├── image-more.rkt │ │ ├── img-err.rkt │ │ ├── info.rkt │ │ ├── last.rkt │ │ ├── launch-many-worlds.rkt │ │ ├── logging-gui.rkt │ │ ├── pad.rkt │ │ ├── planetcute-image-list.rkt │ │ ├── stop.rkt │ │ ├── timer.rkt │ │ ├── universe-image.rkt │ │ ├── universe.rkt │ │ ├── utilities.rkt │ │ └── world.rkt │ ├── uchat │ │ ├── auxiliaries.rkt │ │ ├── chatter.rkt │ │ ├── readme │ │ ├── server.rkt │ │ └── xrun │ ├── universe-request.txt │ ├── universe-syntax-parse.rkt │ ├── universe.rkt │ └── web-io.rkt ├── LICENSE ├── graphics │ ├── graphics-posn-less-unit.rkt │ ├── graphics-sig.rkt │ ├── graphics-unit.rkt │ ├── graphics.rkt │ ├── info.rkt │ ├── main.rkt │ ├── private │ │ ├── value-turtles-reader.rkt │ │ ├── value-turtles-wxme.rkt │ │ └── value-turtles.rkt │ ├── tests │ │ ├── sixlib.rktl │ │ └── test-docs-complete.rkt │ ├── turtle-examples.rkt │ ├── turtle-test.rkt │ ├── turtles.rkt │ ├── value-turtles-examples.rkt │ ├── value-turtles-test.rkt │ └── value-turtles.rkt ├── htdp │ ├── arrow-gui.rkt │ ├── arrow.rkt │ ├── asl │ │ └── lang │ │ │ └── reader.rkt │ ├── big-draw.rkt │ ├── bsl+ │ │ └── lang │ │ │ └── reader.rkt │ ├── bsl │ │ ├── lang │ │ │ └── reader.rkt │ │ ├── print-width.rkt │ │ ├── reader.rkt │ │ └── runtime.rkt │ ├── color-structs.rkt │ ├── convert.rkt │ ├── dir.rkt │ ├── docs.rkt │ ├── draw-sig.rkt │ ├── draw.rkt │ ├── elevator.rkt │ ├── error.rkt │ ├── error.txt │ ├── graphing.rkt │ ├── guess-gui.rkt │ ├── guess.rkt │ ├── gui.rkt │ ├── hangman-play.rkt │ ├── hangman.rkt │ ├── image.rkt │ ├── info.rkt │ ├── isl+ │ │ └── lang │ │ │ └── reader.rkt │ ├── isl │ │ └── lang │ │ │ └── reader.rkt │ ├── lkup-gui.rkt │ ├── master-play.rkt │ ├── master.rkt │ ├── matrix-invisible.rkt │ ├── matrix-render-sig.rkt │ ├── matrix-sig.rkt │ ├── matrix-unit.rkt │ ├── matrix.rkt │ ├── matrix.txt │ ├── servlet.rkt │ ├── servlet2.rkt │ ├── show-queen.rkt │ ├── testing.rkt │ └── world.rkt ├── info.rkt ├── lang │ ├── doc.txt │ ├── error.rkt │ ├── htdp-advanced-reader.rkt │ ├── htdp-advanced.rkt │ ├── htdp-beginner-abbr-reader.rkt │ ├── htdp-beginner-abbr.rkt │ ├── htdp-beginner-reader.rkt │ ├── htdp-beginner.rkt │ ├── htdp-intermediate-lambda-reader.rkt │ ├── htdp-intermediate-lambda.rkt │ ├── htdp-intermediate-reader.rkt │ ├── htdp-intermediate.rkt │ ├── htdp-langs-interface.rkt │ ├── htdp-langs-save-file-prefix.rkt │ ├── htdp-langs.rkt │ ├── htdp-reader.rkt │ ├── imageeq.rkt │ ├── info.rkt │ ├── plt-pretty-big-text.rkt │ ├── plt-pretty-big.rkt │ ├── posn.rkt │ ├── prim.rkt │ ├── private │ │ ├── advanced-funs.rkt │ │ ├── and-or-map.rkt │ │ ├── beginner-funs.rkt │ │ ├── continuation-mark-key.rkt │ │ ├── create-htdp-executable.rkt │ │ ├── firstorder.rkt │ │ ├── imageeq.rkt │ │ ├── intermediate-funs.rkt │ │ ├── intermediate-plus.rkt │ │ ├── provide-and-scribble.rkt │ │ ├── rewrite-error-message.rkt │ │ ├── set-result.rkt │ │ ├── signature-syntax.rkt │ │ ├── sl-eval.rkt │ │ ├── sl-stepper-button.rkt │ │ ├── teach-module-begin.rkt │ │ ├── teach-shared.rkt │ │ ├── teach.rkt │ │ ├── teachhelp.rkt │ │ ├── teachprims.rkt │ │ ├── textbook-pls-spec.rkt │ │ ├── todo.rkt │ │ └── tp-dialog.rkt │ ├── r5rs.rkt │ ├── run-teaching-program.rkt │ ├── stepper-language-interface.rkt │ └── test-error.rkt ├── stepper │ ├── DESIGN-NOTES │ ├── HISTORY.txt │ ├── command-line-debugger-example.rkt │ ├── doc.txt │ ├── drracket-button.rkt │ ├── examples │ │ ├── bobby.rkt │ │ └── external-interface-example.rkt │ ├── external-interface.rkt │ ├── info.rkt │ ├── internal-docs.txt │ ├── private │ │ ├── annotate.rkt │ │ ├── beginner-defined.rkt │ │ ├── display-break-stuff.rkt │ │ ├── find-tag.rkt │ │ ├── lifting.rkt │ │ ├── macro-unwind.rkt │ │ ├── marks.rkt │ │ ├── model-settings.rkt │ │ ├── model.rkt │ │ ├── mred-extensions.rkt │ │ ├── my-macros.rkt │ │ ├── reconstruct.rkt │ │ ├── shared-typed.rkt │ │ ├── shared.rkt │ │ ├── step-img.rkt │ │ ├── syntax-hider.rkt │ │ ├── syntax-property.rkt │ │ ├── vertical-separator-snip.rkt │ │ ├── view-controller-typed.rkt │ │ ├── view-controller.rkt │ │ ├── xml-box.rkt │ │ ├── xml-sig.rkt │ │ └── xml-snip-helpers.rkt │ ├── stepper+xml-tool.rkt │ ├── stepper-tool.rkt │ └── xml-tool.rkt ├── teachpack │ ├── 2htdp │ │ ├── abstraction.rkt │ │ ├── batch-io.rkt │ │ ├── image.rkt │ │ ├── info.rkt │ │ ├── itunes.rkt │ │ ├── scribblings │ │ │ └── img-eval.rkt │ │ ├── universe.rkt │ │ └── web-io.rkt │ ├── HISTORY.txt │ ├── balls.gif │ ├── balls.ss │ ├── data.csv │ ├── data.txt │ ├── door.ss │ ├── htdp │ │ ├── arrow-gui.rkt │ │ ├── arrow.rkt │ │ ├── convert.rkt │ │ ├── dir.rkt │ │ ├── docs.rkt │ │ ├── draw.rkt │ │ ├── elevator.rkt │ │ ├── graphing.rkt │ │ ├── guess-gui.rkt │ │ ├── guess.rkt │ │ ├── gui.rkt │ │ ├── hangman.rkt │ │ ├── image.rkt │ │ ├── info.rkt │ │ ├── lkup-gui.rkt │ │ ├── master.rkt │ │ ├── matrix.rkt │ │ ├── servlet.rkt │ │ ├── servlet2.rkt │ │ ├── show-queen.rkt │ │ ├── testing.rkt │ │ └── world.rkt │ ├── info.rkt │ ├── nuworld.ss │ ├── server.ss │ ├── tests │ │ └── test-docs-complete.rkt │ ├── turtles.ss │ ├── value-turtles.ss │ └── world.ss ├── test-engine │ ├── README.md │ ├── info.rkt │ ├── markup-gui.rkt │ ├── racket-tests.rkt │ ├── scheme-tests.rkt │ ├── srcloc.rkt │ ├── syntax.rkt │ ├── test-display-gui.rkt │ ├── test-engine.rkt │ ├── test-markup.rkt │ └── test-tool.rkt ├── typed │ └── test-engine │ │ ├── racket-tests.rkt │ │ ├── scheme-tests.rkt │ │ └── type-env-ext.rkt └── xml │ ├── info.rkt │ ├── scheme-snipclass.rkt │ ├── text-box-tool.rkt │ ├── text-snipclass.rkt │ ├── xml-snipclass.rkt │ └── xml.png ├── htdp-test ├── 2htdp │ ├── TESTME.txt │ ├── info.rkt │ ├── tests │ │ ├── .gitignore │ │ ├── abstraction-errors.rkt │ │ ├── abstraction-use.rkt │ │ ├── bad-draw.rkt │ │ ├── batch-io-csv-ho.rkt │ │ ├── batch-io-csv-ho.txt │ │ ├── batch-io-xexpr-enumeration.xml │ │ ├── batch-io-xexpr-machine.xml │ │ ├── batch-io-xexpr.rkt │ │ ├── batch-io.rkt │ │ ├── batch-io2.rkt │ │ ├── batch-io3.rkt │ │ ├── bitmap-as-image-in-universe.rkt │ │ ├── bmp-5.0.1.rktd │ │ ├── bmp-5.1.3.rktd │ │ ├── check-with-test.rkt │ │ ├── clause-once.rkt │ │ ├── close-on-stop.rkt │ │ ├── error-in-draw.rkt │ │ ├── error-in-tick.rkt │ │ ├── error-messages.rkt │ │ ├── error-to-draw.rkt │ │ ├── full-scene-visible.rkt │ │ ├── full-test-width-height.rkt │ │ ├── full-test.rkt │ │ ├── image-equality-performance-htdp.rkt │ │ ├── image-equality-performance.rkt │ │ ├── image-too-large.rkt │ │ ├── info.rkt │ │ ├── jpr-bug.rkt │ │ ├── key-error.rkt │ │ ├── lauch-many-worlds-proc.rkt │ │ ├── mouse-evt.rkt │ │ ├── mp.rkt │ │ ├── name.rkt │ │ ├── on-release-no-key.rkt │ │ ├── on-tick-defined.rkt │ │ ├── on-tick-universe-with-limit.rkt │ │ ├── on-tick-with-limit.rkt │ │ ├── pad1-handler.rkt │ │ ├── pad1-in-bsl.rkt │ │ ├── pad1.rkt │ │ ├── perform-record.rkt │ │ ├── perform-record.txt │ │ ├── perform-robby.rkt │ │ ├── perform-whack.rkt │ │ ├── planetcute-runs.rkt │ │ ├── profile-robby.rkt │ │ ├── proper-hiilite-in-hash-lang.rkt │ │ ├── random-seed-works.rkt │ │ ├── record-stop-when.rkt │ │ ├── record.rkt │ │ ├── release.rkt │ │ ├── run-movie.rkt │ │ ├── server-rename.rkt │ │ ├── stop-when-bad-draw.rkt │ │ ├── stop-when-crash.rkt │ │ ├── stop-when-error.rkt │ │ ├── stop-when-not-boolean.rkt │ │ ├── stop.rkt │ │ ├── struct-universe.rkt │ │ ├── test-aux.rkt │ │ ├── test-docs-complete.rkt │ │ ├── test-image.rkt │ │ ├── to-draw-error.rkt │ │ ├── two-ports.rkt │ │ ├── two-universes-running.rkt │ │ ├── u.png │ │ ├── ufo-rename.rkt │ │ ├── universe-disappearing.rkt │ │ ├── universe-receive.rkt │ │ ├── universe-restart.rkt │ │ ├── web-io-automatic.rkt │ │ ├── web-io-manual.rkt │ │ ├── world-dies-while-receiving.rkt │ │ └── world0-stops.rkt │ ├── utest │ │ ├── README │ │ ├── balls.rkt │ │ ├── design.txt │ │ ├── info.rkt │ │ ├── player │ │ ├── sam.rkt │ │ ├── shared.rkt │ │ └── xrun │ ├── xmanual │ └── xtest ├── LICENSE ├── htdp │ ├── info.rkt │ └── tests │ │ ├── TEST │ │ ├── TODO │ │ ├── arrow-gui.rkt │ │ ├── arrow.rkt │ │ ├── convert-drracket-error.rkt │ │ ├── convert-drracket-error.txt │ │ ├── convert-drracket-non-error.txt │ │ ├── convert.rkt │ │ ├── dir-aux.rkt │ │ ├── dir.rkt │ │ ├── docs.rkt │ │ ├── draw.rkt │ │ ├── elevator.rkt │ │ ├── graphing.rkt │ │ ├── guess1.rkt │ │ ├── guess2.rkt │ │ ├── guess3.rkt │ │ ├── gui.rkt │ │ ├── hangman-error.rkt │ │ ├── hangman1.rkt │ │ ├── info.rkt │ │ ├── lkup-gui.rkt │ │ ├── master.rkt │ │ ├── matrix-client-racket.rkt │ │ ├── matrix-client.rkt │ │ ├── matrix-example.rkt │ │ ├── matrix-test.rkt │ │ ├── test-docs-complete.rkt │ │ ├── tester.rkt │ │ ├── value-turtles.rkt │ │ ├── world-add-line.rkt │ │ ├── world-mouse.rkt │ │ └── world.rkt ├── info.rkt └── tests │ ├── htdp-lang │ ├── README │ ├── advanced.rktl │ ├── arrow-tests.rkt │ ├── beg-adv.rktl │ ├── beg-bega.rktl │ ├── beg-intm.rktl │ ├── beg-intml.rktl │ ├── bega-adv.rktl │ ├── beginner-abbr.rktl │ ├── beginner.rktl │ ├── htdp-test.rktl │ ├── info.rkt │ ├── intermediate-lambda.rktl │ ├── intermediate.rktl │ ├── intm-adv.rktl │ ├── intm-intml.rktl │ ├── intm-lam.rktl │ ├── intmlam-adv.rktl │ ├── pr │ │ └── 12117.rkt │ ├── prim.rkt │ ├── reader-settings.rkt │ ├── signatures.rkt │ ├── syntax.rkt │ ├── test-htdp.rkt │ └── test-image.rkt │ ├── stepper │ ├── already-defined.rktl │ ├── annotation-helper.rkt │ ├── annotation.rkt │ ├── automatic-tests.rkt │ ├── bad-letrec-test.rktl │ ├── big-bang-test.rkt │ ├── constructor-redexes.rktl │ ├── find-tag-test.rkt │ ├── global-prim-reduction.rktl │ ├── image-test.rktl │ ├── info.rkt │ ├── intermediate-y.rktl │ ├── jump-to-ui-test.rkt │ ├── lambda-test.rktl │ ├── language-level-model.rkt │ ├── let-test.rktl │ ├── letrec-test.rktl │ ├── local-define-struct.rktl │ ├── local-test-2.rktl │ ├── local-test.rktl │ ├── long-error-message.rktl │ ├── manual-tests.txt │ ├── multiply-defined.rktl │ ├── name-chaining.rktl │ ├── no-else-clause.rktl │ ├── non-procedure.rktl │ ├── print-convert-test.rktl │ ├── printing-reducing-test.rktl │ ├── procedure-display.rktl │ ├── recur-test │ ├── right-redex.rktl │ ├── run-manual-tests.rkt │ ├── structures.rktl │ ├── symbol-identifier.rktl │ ├── symbols.rktl │ ├── syntax-error-ordering.rktl │ ├── test-abbrev.rkt │ ├── test-cases.rkt │ ├── test-engine.rkt │ ├── test-or.rktl │ ├── through-tests.rkt │ ├── two-tests.rktl │ ├── unannotated.rktl │ ├── undefined.rktl │ ├── world-test.rktl │ └── write-display.rktl │ ├── test-engine │ ├── TestEngineTest.rkt │ ├── at-top-level.rkt │ ├── check-error-message.rkt │ ├── check-expect.rkt │ ├── check-failed-bsl.rkt │ ├── check-failed-isl.rkt │ ├── check-ordered.rkt │ ├── check-satisfied.rkt │ ├── check-satisfied1.rkt │ ├── check-satisfied2.rkt │ ├── check-satisfied3.rkt │ ├── check-satisfied4.rkt │ ├── check-satisfied5.rkt │ ├── check-satisfied6.rkt │ ├── check-satisfied7.rkt │ ├── check-satisfied8.rkt │ ├── check-satisfied9.rkt │ ├── info.rkt │ ├── racket-tests.rkt │ └── signature-asl.rkt │ └── xml │ └── xml-snip-bug.rkt └── htdp ├── LICENSE └── info.rkt /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: Build and Test 2 | 3 | on: [push, pull_request] 4 | 5 | jobs: 6 | build-test: 7 | runs-on: ubuntu-22.04 8 | strategy: 9 | fail-fast: false 10 | matrix: 11 | racket-variant: ["BC", "CS"] 12 | 13 | steps: 14 | - uses: actions/checkout@v3.5.3 15 | - uses: Bogdanp/setup-racket@v1.10 16 | with: 17 | architecture: 'x64' 18 | distribution: 'full' 19 | variant: ${{ matrix.racket-variant }} 20 | version: current 21 | sudo: never 22 | dest: '${HOME}/racket' 23 | local_catalogs: $GITHUB_WORKSPACE 24 | - run: raco pkg update -i --no-setup htdp-lib htdp-doc htdp 25 | - name: Install htdp-test (depends on htdp-lib) 26 | run: raco pkg install --auto -i --skip-installed --no-setup htdp-test 27 | - run: raco setup --check-pkg-deps --pkgs htdp-lib htdp-doc htdp-test 28 | - name: Run tests 29 | run: xvfb-run raco test htdp-test 30 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Racket compiled files 2 | compiled/ 3 | 4 | # common backups, autosaves, lock files, OS meta-files 5 | *~ 6 | \#* 7 | .#* 8 | .DS_Store 9 | *.bak 10 | TAGS 11 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | This component of Racket is distributed under the Apache 2.0 and MIT 2 | licenses. The user can choose the license under which they will be 3 | using the software. There may be other licenses within the 4 | distribution with which the user must also comply. 5 | 6 | See the files 7 | https://github.com/racket/racket/blob/master/racket/src/LICENSE-APACHE.txt 8 | and 9 | https://github.com/racket/racket/blob/master/racket/src/LICENSE-MIT.txt 10 | for the full text of the licenses. 11 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # htdp 2 | 3 | This is the source for the Racket packages: "htdp", "htdp-doc", "htdp-lib", "htdp-test". 4 | 5 | ### Contributing 6 | 7 | Contribute to Racket by submitting a [pull request], reporting an 8 | [issue], joining the [development mailing list], or visiting the 9 | IRC or Slack channels. 10 | 11 | ### License 12 | 13 | Racket, including these packages, is free software, see [LICENSE] 14 | for more details. 15 | 16 | By making a contribution, you are agreeing that your contribution 17 | is licensed under the [Apache 2.0] license and the [MIT] license. 18 | 19 | [MIT]: https://github.com/racket/racket/blob/master/racket/src/LICENSE-MIT.txt 20 | [Apache 2.0]: https://www.apache.org/licenses/LICENSE-2.0.txt 21 | [pull request]: https://github.com/racket/htdp/pulls 22 | [issue]: https://github.com/racket/htdp/issues 23 | [development mailing list]: https://lists.racket-lang.org 24 | [LICENSE]: LICENSE 25 | -------------------------------------------------------------------------------- /htdp-doc/LICENSE: -------------------------------------------------------------------------------- 1 | This component of Racket is distributed under the Apache 2.0 and MIT 2 | licenses. The user can choose the license under which they will be 3 | using the software. There may be other licenses within the 4 | distribution with which the user must also comply. 5 | 6 | See the files 7 | https://github.com/racket/racket/blob/master/racket/src/LICENSE-APACHE.txt 8 | and 9 | https://github.com/racket/racket/blob/master/racket/src/LICENSE-MIT.txt 10 | for the full text of the licenses. 11 | -------------------------------------------------------------------------------- /htdp-doc/graphics/scribblings/common.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require scribble/manual 4 | (for-label scheme/base 5 | scheme/contract 6 | scheme/class 7 | scheme/unit 8 | scheme/gui/base)) 9 | (provide (all-from-out scribble/manual) 10 | (for-label (all-from-out scheme/base 11 | scheme/contract 12 | scheme/class 13 | scheme/unit 14 | scheme/gui/base))) 15 | -------------------------------------------------------------------------------- /htdp-doc/graphics/scribblings/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define scribblings '(("graphics.scrbl" (multi-page) (legacy)) 4 | ("turtles.scrbl" (multi-page) (gui-library)))) 5 | (define doc-categories '(legacy library)) 6 | -------------------------------------------------------------------------------- /htdp-doc/graphics/scribblings/turtles.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/doc 2 | @(require scribble/manual) 3 | 4 | @title{Turtle Graphics} 5 | 6 | Turtle graphics are available in two forms: traditional imperative 7 | turtle operations that draw into a fixed window, and functional turtle 8 | operations that consume and produce a turtle picture. 9 | 10 | @table-of-contents[] 11 | 12 | @include-section["traditional-turtles.scrbl"] 13 | @include-section["value-turtles.scrbl"] 14 | -------------------------------------------------------------------------------- /htdp-doc/htdp/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define scribblings '(("htdp.scrbl"))) 4 | -------------------------------------------------------------------------------- /htdp-doc/htdp/testing.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/doc 2 | 3 | @(require scribble/manual 4 | (for-label test-engine/racket-tests 5 | (only-in racket/base void?) 6 | (only-in htdp/testing generate-report))) 7 | 8 | @title{Testing} 9 | 10 | @; ----------------------------------------------------------------------------- 11 | @defmodule[htdp/testing #:use-sources (test-engine/racket-tests)] 12 | 13 | The library re-exports the identifiers from @racketmodname[test-engine/racket-tests]. 14 | 15 | In addition, it exports: 16 | 17 | @defproc[(generate-report) void?]{The same as @racket[test].} 18 | 19 | @(require scribble/eval 20 | (for-label racket/contract 21 | racket/class 22 | racket/gui/base 23 | lang/posn 24 | lang/imageeq 25 | lang/prim)) 26 | 27 | @(define (htdp-ref s) @secref[#:doc '(lib "scribblings/htdp-langs/htdp-langs.scrbl") s]) 28 | 29 | -------------------------------------------------------------------------------- /htdp-doc/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection 'multi) 4 | 5 | (define deps 6 | '("base" 7 | "scribble-lib" 8 | "at-exp-lib" 9 | "draw-lib" 10 | ["gui-lib" #:version "1.37"] 11 | "htdp-lib" 12 | "plai" 13 | "sandbox-lib" 14 | "pict-lib")) 15 | (define build-deps '("mzscheme-doc" 16 | "scheme-lib" 17 | "compatibility-doc" 18 | "draw-doc" 19 | "drracket" 20 | "gui-doc" 21 | "pict-doc" 22 | "racket-doc" 23 | #;"at-exp-lib" 24 | #;"rackunit-lib")) 25 | (define update-implies '("htdp-lib")) 26 | 27 | (define pkg-desc "documentation part of \"htdp\"") 28 | 29 | (define pkg-authors '(matthias mflatt robby "sperber@deinprogramm.de")) 30 | 31 | (define license 32 | '(Apache-2.0 OR MIT)) 33 | -------------------------------------------------------------------------------- /htdp-doc/scribblings/htdp-langs/htdp-ptr.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/base 2 | @(require scribble/core 3 | net/url 4 | scribble/html-properties) 5 | 6 | @(define redirect 7 | (style #f (list (part-link-redirect (string->url "http://www.htdp.org/"))))) 8 | 9 | @title[#:style redirect]{@italic{How to Design Programs}} 10 | 11 | See @hyperlink["http://www.htdp.org/"]{the book's web site}. 12 | -------------------------------------------------------------------------------- /htdp-doc/scribblings/htdp-langs/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define scribblings '(("htdp-langs.scrbl" (multi-page) (teaching -12 ("HtDP"))) 4 | ("htdp-ptr.scrbl" () (teaching -11)))) 5 | -------------------------------------------------------------------------------- /htdp-doc/stepper/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define scribblings '(("scribblings/stepper.scrbl"))) 4 | 5 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/2htdp/scribblings/2htdp.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/doc 2 | 3 | @(require scribble/manual 4 | (for-label scheme)) 5 | 6 | @title[#:style '(toc) #:tag "2htdp" #:tag-prefix "2htdp"]{HtDP/2e Teachpacks} 7 | 8 | @local-table-of-contents[] 9 | 10 | @include-section["batch-io.scrbl"] 11 | @include-section["image-guide.scrbl"] 12 | @include-section["image.scrbl"] 13 | @include-section["universe.scrbl"] 14 | @include-section["web-io.scrbl"] 15 | @include-section["itunes.scrbl"] 16 | @include-section["abstraction.scrbl"] 17 | @include-section["planetcute.scrbl"] 18 | @include-section["port.scrbl"] 19 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/2htdp/scribblings/PlanetCuteShadow1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-doc/teachpack/2htdp/scribblings/PlanetCuteShadow1.png -------------------------------------------------------------------------------- /htdp-doc/teachpack/2htdp/scribblings/PlanetCuteShadow2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-doc/teachpack/2htdp/scribblings/PlanetCuteShadow2.png -------------------------------------------------------------------------------- /htdp-doc/teachpack/2htdp/scribblings/PlanetCuteShadow2b.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-doc/teachpack/2htdp/scribblings/PlanetCuteShadow2b.png -------------------------------------------------------------------------------- /htdp-doc/teachpack/2htdp/scribblings/PlanetCuteShadow3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-doc/teachpack/2htdp/scribblings/PlanetCuteShadow3.png -------------------------------------------------------------------------------- /htdp-doc/teachpack/2htdp/scribblings/PlanetCuteShadowMockup.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-doc/teachpack/2htdp/scribblings/PlanetCuteShadowMockup.jpg -------------------------------------------------------------------------------- /htdp-doc/teachpack/2htdp/scribblings/data-plain.xml: -------------------------------------------------------------------------------- 1 | 
2 | 
3 | 
4 | 
5 | 
6 |
7 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/2htdp/scribblings/data.csv: -------------------------------------------------------------------------------- 1 | hello, world 2 | good, bye 3 | i, am, done 4 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/2htdp/scribblings/data.txt: -------------------------------------------------------------------------------- 1 | hello world 2 | good bye 3 | 4 | i, for 1, am done 5 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/2htdp/scribblings/data.xml: -------------------------------------------------------------------------------- 1 | 
2 | hello world
3 | good bye
4 | 
5 | i, for 1, am done
6 |
7 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/2htdp/scribblings/image-util.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require scribble/eval) 3 | 4 | (provide image-examples) 5 | 6 | (define img-eval (make-base-eval)) 7 | (interaction-eval #:eval img-eval (require 2htdp/image)) 8 | 9 | (define-syntax-rule 10 | (image-examples exp ...) 11 | (examples #:eval img-eval exp ...)) 12 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/2htdp/scribblings/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define test-responsibles '(("image.scrbl" robby) 4 | ("image-util.rkt" robby))) 5 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/2htdp/scribblings/io.css: -------------------------------------------------------------------------------- 1 | 2 | .FileBox { 3 | width: 16em; 4 | margin: 0px; 5 | padding: 0px; 6 | background-color: #eee; 7 | border: 1px solid #ddd; 8 | text-align: center; 9 | vertical-align: middle; 10 | } 11 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/2htdp/scribblings/io.tex: -------------------------------------------------------------------------------- 1 | 2 | \usepackage{framed} 3 | 4 | \newenvironment{FileBox}{\begin{minipage}{4in}\begin{framed}}{\end{framed}\end{minipage}} 5 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/2htdp/scribblings/ligature.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-doc/teachpack/2htdp/scribblings/ligature.png -------------------------------------------------------------------------------- /htdp-doc/teachpack/2htdp/scribblings/port.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme 2 | 3 | (require scribble/core) 4 | 5 | (define (port old new) 6 | (make-table 7 | (make-style 'boxed '()) 8 | (list 9 | (list (make-paragraph plain "World Style") (make-paragraph plain "Universe Style")) 10 | (list old new)))) 11 | 12 | (provide port) 13 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/2htdp/scribblings/shared.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require "../../htdp/scribblings/shared.rkt") 4 | 5 | (provide teachpack beginner-require) 6 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/2htdp/scribblings/web-io.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require "shared.rkt" (for-label racket xml/xml)) 4 | 5 | @teachpack["web-io"]{Web IO} 6 | @author{Matthias Felleisen} 7 | 8 | @defmodule[#:require-form beginner-require 2htdp/web-io] 9 | 10 | The teachpack provides a single function: 11 | 12 | @defproc[(show-in-browser [x xexpr?]) string?]{ 13 | Translates the given X-expression into a String. It also has the 14 | @bold{effect} of opening an external browser and displaying the 15 | X-expression rendered as XHTML. 16 | 17 | @bold{Example} 18 | 19 | @racketblock[(show-in-browser '(html (body (b "hello world"))))] 20 | 21 | } 22 | 23 | @history[ 24 | #:added "1.0" @;{list{Fri Nov 3 11:49:40 EDT 2017}} 25 | ] 26 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/balls.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-doc/teachpack/balls.png -------------------------------------------------------------------------------- /htdp-doc/teachpack/door-real.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-doc/teachpack/door-real.png -------------------------------------------------------------------------------- /htdp-doc/teachpack/door-sim.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-doc/teachpack/door-sim.png -------------------------------------------------------------------------------- /htdp-doc/teachpack/gamepad.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-doc/teachpack/gamepad.png -------------------------------------------------------------------------------- /htdp-doc/teachpack/htdp/scribblings/elevator.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/doc 2 | 3 | @(require scribble/manual "shared.rkt" 4 | (for-label racket teachpack/htdp/elevator)) 5 | 6 | @teachpack["elevator"]{Controlling an Elevator} 7 | 8 | @;declare-exporting[teachpack/htdp/elevator] 9 | @defmodule[#:require-form beginner-require htdp/elevator] 10 | 11 | The teachpack implements an elevator simulator. 12 | 13 | It displays an eight-floor elevator and accepts mouse clicks from the user, 14 | which are translated into service demands for the elevator. 15 | 16 | @defproc[(run [NextFloor number?]) any/c]{Creates an elevator simulator 17 | that is controlled by @racket[NextFloor]. This function consumes the 18 | current floor, the direction in which the elevator is moving, and the 19 | current demands. From that, it computes where to send the elevator next.} 20 | 21 | Example: Define a function that consumes the current state of 22 | the elevator (three arguments) and returns a number between 1 and 8. Here 23 | is a non-sensical definition: 24 | 25 | @racketblock[(define (controller x y z) 7)] 26 | 27 | It moves the elevator once, to the 7th floor. 28 | 29 | Second, set the teachpack to @filepath{elevator.rkt}, click Run, and 30 | evaluate 31 | @racketblock[(run controller)] 32 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/htdp/scribblings/graphing.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/doc 2 | 3 | @(require scribble/manual "shared.rkt" 4 | (for-label racket teachpack/htdp/graphing)) 5 | 6 | @teachpack["graphing"]{Graphing Functions} 7 | 8 | @;declare-exporting[teachpack/htdp/graphing] 9 | @defmodule[#:require-form beginner-require htdp/graphing #:use-sources (htdp/draw)] 10 | 11 | The teachpack provides two functions for graphing functions in the regular 12 | (upper right) quadrant of the Cartesian plane (between 0 and 10 in both 13 | directions): 14 | 15 | @defproc[(graph-fun [f (-> number? number?)][color symbol?]) true]{ 16 | Draws the graph of @racket[f] with the given @racket[color].} 17 | 18 | @defproc[(graph-line [line (-> number? number?)][color symbol?]) true]{ 19 | Draws @racket[line], a function representing a straight line, with a given 20 | color.} 21 | 22 | For color symbols, see @secref{draw}. 23 | 24 | In addition, the teachpack re-exports the entire functionality of the 25 | drawing library; see @secref{draw} for documentation. 26 | 27 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/htdp/scribblings/guess-gui.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/doc 2 | 3 | @(require scribble/manual "shared.rkt" 4 | (for-label racket teachpack/htdp/guess-gui)) 5 | 6 | @teachpack["guess-gui"]{Guess GUI} 7 | 8 | @defmodule[#:require-form beginner-require htdp/guess-gui] 9 | 10 | The teachpack provides three functions: 11 | 12 | @defproc[(control [index natural-number?]) symbol?]{ 13 | reads out the @racket[index]th guess choice, starting with 0} 14 | 15 | @defproc[(view [msg (or/c string? symbol?)]) true/c]{ 16 | displays its @racket[msg] argument in the message panel} 17 | 18 | @defproc[(connect [handler (-> button% event% true/c)]) true/c]{ 19 | connects a controller (@racket[handler]) with the Check button displays frame} 20 | 21 | Example: 22 | @;% 23 | @(begin 24 | #reader scribble/comment-reader 25 | (racketblock 26 | (connect (lambda (e b) 27 | (begin 28 | (printf "0th digit: ~s~n" (control 0)) 29 | (view (control 0))))) 30 | )) 31 | @;% 32 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/htdp/scribblings/hangman-play.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/doc 2 | 3 | @(require scribble/manual "shared.rkt" 4 | (for-label racket teachpack/htdp/hangman)) 5 | 6 | @teachpack["hangman-play"]{Playing Hangman} 7 | 8 | @defmodule[#:require-form beginner-require htdp/hangman-play] 9 | 10 | The teachpack implements the Hangman game so that students can play the 11 | game and get an understanding of what we expect from them. 12 | 13 | @defproc[(go [name symbol?]) true]{ 14 | chooses a ``secret'' three-letter word, opens a canvas and a menu, 15 | and asks the player to guess the word.} 16 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/htdp/scribblings/htdp.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/doc 2 | 3 | @(require scribble/manual 4 | (for-label racket)) 5 | 6 | @title[#:style '(toc) #:tag "htdp"]{HtDP Teachpacks} 7 | 8 | @local-table-of-contents[] 9 | 10 | @include-section["image.scrbl"] 11 | @include-section["world.scrbl"] 12 | 13 | @include-section["convert.scrbl"] 14 | @include-section["guess.scrbl"] 15 | @include-section["master.scrbl"] 16 | @include-section["master-play.scrbl"] 17 | @include-section["draw.scrbl"] 18 | @include-section["hangman.scrbl"] 19 | @include-section["hangman-play.scrbl"] 20 | @include-section["arrow.scrbl"] 21 | @include-section["docs.scrbl"] 22 | @include-section["dir.scrbl"] 23 | @include-section["graphing.scrbl"] 24 | @include-section["gui.scrbl"] 25 | @include-section["arrow-gui.scrbl"] 26 | @include-section["elevator.scrbl"] 27 | @include-section["lkup-gui.scrbl"] 28 | @include-section["guess-gui.scrbl"] 29 | @include-section["show-queen.scrbl"] 30 | 31 | @include-section["matrix.scrbl"] 32 | 33 | @;-- what do those do? -- 34 | 35 | @;include-section["Simplified Racket Web Servlets"] 36 | @;include-section["Racket Web Servlets"] 37 | 38 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/htdp/scribblings/lkup-gui.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/doc 2 | 3 | @(require scribble/manual "shared.rkt" (for-label racket teachpack/htdp/lkup-gui)) 4 | 5 | @teachpack["lkup-gui"]{Lookup GUI} 6 | 7 | @defmodule[#:require-form beginner-require htdp/lkup-gui] 8 | 9 | The teachpack provides three functions: 10 | 11 | @defproc[(control [index natural-number?]) symbol?]{ 12 | reads out the @racket[index]th guess choice, starting with 0} 13 | 14 | @defproc[(view [msg (or/c string? symbol?)]) true/c]{ 15 | displays its @racket[msg] argument in the message panel} 16 | 17 | @defproc[(connect [event-handler (-> button% event% true/c)]) true/c]{ 18 | connects a controller (@racket[handler]) with the Check button displays frame} 19 | 20 | Example: 21 | @;% 22 | @(begin 23 | #reader scribble/comment-reader 24 | (racketblock 25 | (connect 26 | (lambda (e b) 27 | (view (control)))) 28 | )) 29 | @;% 30 | This example simply mirrors what the user types in to the message field. 31 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/htdp/scribblings/master-play.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/doc 2 | 3 | @(require scribble/manual "shared.rkt" (for-label racket teachpack/htdp/master)) 4 | 5 | @teachpack["master-play"]{Playing MasterMind} 6 | 7 | @defmodule[#:require-form beginner-require htdp/master-play] 8 | 9 | The teachpack implements the MasterMind game so that students can play the 10 | game and get an understanding of what we expect from them. 11 | 12 | @defproc[(go [name symbol?]) true]{ 13 | chooses a ``secret'' three-letter word, opens a canvas and a menu, 14 | and asks the player to guess the word.} 15 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/htdp/scribblings/master.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/doc 2 | 3 | @(require scribble/manual "shared.rkt" 4 | (for-label racket teachpack/htdp/master)) 5 | 6 | @teachpack["master"]{MasterMinding} 7 | 8 | @;declare-exporting[teachpack/htdp/master] 9 | @defmodule[#:require-form beginner-require htdp/master] 10 | 11 | The teachpack implements GUI for playing a simple master mind-like game, 12 | based on a function designed by a student. The player clicks on two colors 13 | and the program responds with an answer that indicates how many colors and 14 | places were correct. 15 | 16 | @defproc[(master [check-guess (-> symbol? symbol? symbol? symbol? boolean?)]) symbol?]{ 17 | Chooses two ``secret'' colors and then opens a graphical user interface for 18 | playing @emph{MasterMind}. The player is prompted to choose two colors, via 19 | a choice tablet and mouse clicks. Once chosen, @racket[master] uses 20 | @racket[check-guess] to compare them. 21 | 22 | If the two guesses completely match the two secret colors, 23 | @racket[check-guess] must return @racket['PerfectGuess]; otherwise it must 24 | return a different, informative symbol.} 25 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/htdp/scribblings/shared.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require scribble/manual 4 | scribble/core 5 | scribble/html-properties) 6 | 7 | (provide teachpack 8 | beginner-require) 9 | 10 | (define (teachpack #:svg? [svg? #f] tp . name) 11 | (apply title #:tag tp 12 | #:style (if svg? 13 | (style #f (list (render-convertible-as '(svg-bytes png-bytes)))) 14 | #f) 15 | `(,@name ": " ,(filepath (format "~a.rkt" tp)) 16 | ,(index (format "~a teachpack" tp))))) 17 | 18 | (define-syntax-rule (def-req beg-require) 19 | (begin 20 | (require (for-label lang/htdp-beginner)) 21 | (define beg-require (racket require)))) 22 | (def-req beginner-require) 23 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/htdp/scribblings/show-queen.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/doc 2 | 3 | @(require scribble/manual "shared.rkt" 4 | (for-label racket teachpack/htdp/show-queen)) 5 | 6 | @teachpack["show-queen"]{Queens} 7 | 8 | @;declare-exporting[teachpack/htdp/show-queen] 9 | @defmodule[#:require-form beginner-require htdp/show-queen] 10 | 11 | The teachpack provides the function @racket[show-queen], which implements 12 | a GUI for exploring the n-queens problem. 13 | 14 | @defproc[(show-queen [board (list-of (list-of boolean?))]) true]{The 15 | function @racket[show-queen] consumes a list of 16 | lists of booleans that describes a @racket[board]. Each of the inner 17 | lists must have the same length as the outer list. The 18 | @racket[true]s correspond to positions where queens are, 19 | and the @racket[false]s correspond to empty squares. The 20 | function returns nothing. 21 | 22 | In the GUI window that @racket[show-queen] opens, the 23 | red and orange dots show where the queens are. The green dot 24 | shows where the mouse cursor is. Each queen that threatens 25 | the green spot is shown in red, and the queens that do not 26 | threaten the green spot are shown in orange.} 27 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define scribblings '(("teachpack.scrbl" (multi-page) (teaching -13 ("HtDP"))))) 4 | 5 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/nuworld.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-doc/teachpack/nuworld.png -------------------------------------------------------------------------------- /htdp-doc/teachpack/server.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-doc/teachpack/server.png -------------------------------------------------------------------------------- /htdp-doc/teachpack/teachpack.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/doc 2 | 3 | 4 | @(require scribble/manual 5 | (for-label scheme/base)) 6 | 7 | @title[#:style '(toc) #:tag "top"]{@italic{How to Design Programs} Teachpacks} 8 | 9 | Teaching languages are small subsets of a full programming language. While 10 | such restrictions simplify error diagnosis and the construction of tools, 11 | they also make it impossible (or at least difficult) to write some 12 | interesting programs. To circumvent this restriction, it is possible to 13 | import teachpacks into programs written in a teaching language. 14 | 15 | In principle, a teachpack is just a library written in the full language, 16 | not the teaching subset. Like any other library, it may export values, 17 | functions, etc. In contrast to an ordinary library, however, a teachpack 18 | must enforce the contracts of the ``lowest'' teaching language into which it 19 | is imported and signal errors in a way with which students are familiar at 20 | that level. 21 | 22 | This chapter covers the teachpacks for @italic{How to Design Programs}. 23 | 24 | @table-of-contents[] 25 | 26 | @include-section["htdp/scribblings/htdp.scrbl"] 27 | 28 | @; removed: @include-section["htdc/scribblings/htdc.scrbl"] 29 | 30 | @include-section["2htdp/scribblings/2htdp.scrbl"] 31 | -------------------------------------------------------------------------------- /htdp-doc/teachpack/triangle-xxx.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-doc/teachpack/triangle-xxx.png -------------------------------------------------------------------------------- /htdp-doc/teachpack/universe.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-doc/teachpack/universe.png -------------------------------------------------------------------------------- /htdp-doc/teachpack/world.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-doc/teachpack/world.png -------------------------------------------------------------------------------- /htdp-doc/test-engine/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | (define scribblings '(("test-engine.scrbl" () (tool-library)))) 3 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define name "HtDP/2e Teachpacks") 4 | 5 | (define test-omit-paths '("uchat/chatter.rkt" 6 | "uchat/server.rkt")) 7 | 8 | 9 | (define test-responsibles '(("image.rkt" robby) 10 | (all matthias))) 11 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/langs.txt: -------------------------------------------------------------------------------- 1 | ;; design points for bsl/isl/asl in 2htdp 2 | 3 | *** '() will be the empty list 4 | 5 | *** bsl: current bsl - symbols + '() 6 | *** isl: lambda + local 7 | *** isl+: symbols, quoted and backquoted S-expressions 8 | 9 | *** structures come with dot and update forms (where?) 10 | 11 | *** if checked signatures are added, change libraries to export signatures 12 | for basic things 13 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/brown-block.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/brown-block.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/brown-block.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide brown-block) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path brown-block-img "brown-block.png") 5 | (define brown-block (read-bitmap brown-block-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/character-boy.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/character-boy.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/character-boy.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide character-boy) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path character-boy-img "character-boy.png") 5 | (define character-boy (read-bitmap character-boy-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/character-cat-girl.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/character-cat-girl.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/character-cat-girl.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide character-cat-girl) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path character-cat-girl-img "character-cat-girl.png") 5 | (define character-cat-girl (read-bitmap character-cat-girl-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/character-horn-girl.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/character-horn-girl.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/character-horn-girl.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide character-horn-girl) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path character-horn-girl-img "character-horn-girl.png") 5 | (define character-horn-girl (read-bitmap character-horn-girl-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/character-pink-girl.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/character-pink-girl.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/character-pink-girl.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide character-pink-girl) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path character-pink-girl-img "character-pink-girl.png") 5 | (define character-pink-girl (read-bitmap character-pink-girl-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/character-princess-girl.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/character-princess-girl.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/character-princess-girl.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide character-princess-girl) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path character-princess-girl-img "character-princess-girl.png") 5 | (define character-princess-girl (read-bitmap character-princess-girl-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/chest-closed.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/chest-closed.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/chest-closed.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide chest-closed) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path chest-closed-img "chest-closed.png") 5 | (define chest-closed (read-bitmap chest-closed-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/chest-lid.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/chest-lid.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/chest-lid.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide chest-lid) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path chest-lid-img "chest-lid.png") 5 | (define chest-lid (read-bitmap chest-lid-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/chest-open.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/chest-open.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/chest-open.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide chest-open) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path chest-open-img "chest-open.png") 5 | (define chest-open (read-bitmap chest-open-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/dirt-block.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/dirt-block.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/dirt-block.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide dirt-block) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path dirt-block-img "dirt-block.png") 5 | (define dirt-block (read-bitmap dirt-block-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/door-tall-closed.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/door-tall-closed.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/door-tall-closed.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide door-tall-closed) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path door-tall-closed-img "door-tall-closed.png") 5 | (define door-tall-closed (read-bitmap door-tall-closed-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/door-tall-open.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/door-tall-open.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/door-tall-open.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide door-tall-open) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path door-tall-open-img "door-tall-open.png") 5 | (define door-tall-open (read-bitmap door-tall-open-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/enemy-bug.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/enemy-bug.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/enemy-bug.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide enemy-bug) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path enemy-bug-img "enemy-bug.png") 5 | (define enemy-bug (read-bitmap enemy-bug-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/gem-blue.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/gem-blue.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/gem-blue.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide gem-blue) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path gem-blue-img "gem-blue.png") 5 | (define gem-blue (read-bitmap gem-blue-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/gem-green.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/gem-green.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/gem-green.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide gem-green) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path gem-green-img "gem-green.png") 5 | (define gem-green (read-bitmap gem-green-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/gem-orange.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/gem-orange.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/gem-orange.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide gem-orange) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path gem-orange-img "gem-orange.png") 5 | (define gem-orange (read-bitmap gem-orange-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/grass-block.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/grass-block.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/grass-block.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide grass-block) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path grass-block-img "grass-block.png") 5 | (define grass-block (read-bitmap grass-block-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/heart.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/heart.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/heart.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide heart) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path heart-img "heart.png") 5 | (define heart (read-bitmap heart-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/key.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/key.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/key.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide key) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path key-img "key.png") 5 | (define key (read-bitmap key-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/plain-block.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/plain-block.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/plain-block.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide plain-block) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path plain-block-img "plain-block.png") 5 | (define plain-block (read-bitmap plain-block-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/ramp-east.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/ramp-east.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/ramp-east.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide ramp-east) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path ramp-east-img "ramp-east.png") 5 | (define ramp-east (read-bitmap ramp-east-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/ramp-north.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/ramp-north.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/ramp-north.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide ramp-north) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path ramp-north-img "ramp-north.png") 5 | (define ramp-north (read-bitmap ramp-north-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/ramp-south.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/ramp-south.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/ramp-south.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide ramp-south) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path ramp-south-img "ramp-south.png") 5 | (define ramp-south (read-bitmap ramp-south-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/ramp-west.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/ramp-west.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/ramp-west.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide ramp-west) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path ramp-west-img "ramp-west.png") 5 | (define ramp-west (read-bitmap ramp-west-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/rock.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/rock.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/rock.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide rock) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path rock-img "rock.png") 5 | (define rock (read-bitmap rock-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/roof-east.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/roof-east.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/roof-east.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide roof-east) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path roof-east-img "roof-east.png") 5 | (define roof-east (read-bitmap roof-east-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/roof-north-east.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/roof-north-east.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/roof-north-east.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide roof-north-east) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path roof-north-east-img "roof-north-east.png") 5 | (define roof-north-east (read-bitmap roof-north-east-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/roof-north-west.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/roof-north-west.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/roof-north-west.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide roof-north-west) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path roof-north-west-img "roof-north-west.png") 5 | (define roof-north-west (read-bitmap roof-north-west-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/roof-north.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/roof-north.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/roof-north.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide roof-north) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path roof-north-img "roof-north.png") 5 | (define roof-north (read-bitmap roof-north-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/roof-south-east.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/roof-south-east.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/roof-south-east.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide roof-south-east) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path roof-south-east-img "roof-south-east.png") 5 | (define roof-south-east (read-bitmap roof-south-east-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/roof-south-west.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/roof-south-west.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/roof-south-west.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide roof-south-west) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path roof-south-west-img "roof-south-west.png") 5 | (define roof-south-west (read-bitmap roof-south-west-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/roof-south.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/roof-south.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/roof-south.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide roof-south) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path roof-south-img "roof-south.png") 5 | (define roof-south (read-bitmap roof-south-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/roof-west.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/roof-west.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/roof-west.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide roof-west) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path roof-west-img "roof-west.png") 5 | (define roof-west (read-bitmap roof-west-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/selector.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/selector.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/selector.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide selector) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path selector-img "selector.png") 5 | (define selector (read-bitmap selector-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/shadow-east.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/shadow-east.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/shadow-east.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide shadow-east) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path shadow-east-img "shadow-east.png") 5 | (define shadow-east (read-bitmap shadow-east-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/shadow-north-east.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/shadow-north-east.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/shadow-north-east.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide shadow-north-east) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path shadow-north-east-img "shadow-north-east.png") 5 | (define shadow-north-east (read-bitmap shadow-north-east-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/shadow-north-west.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/shadow-north-west.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/shadow-north-west.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide shadow-north-west) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path shadow-north-west-img "shadow-north-west.png") 5 | (define shadow-north-west (read-bitmap shadow-north-west-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/shadow-north.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/shadow-north.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/shadow-north.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide shadow-north) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path shadow-north-img "shadow-north.png") 5 | (define shadow-north (read-bitmap shadow-north-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/shadow-side-west.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/shadow-side-west.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/shadow-side-west.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide shadow-side-west) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path shadow-side-west-img "shadow-side-west.png") 5 | (define shadow-side-west (read-bitmap shadow-side-west-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/shadow-south-east.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/shadow-south-east.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/shadow-south-east.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide shadow-south-east) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path shadow-south-east-img "shadow-south-east.png") 5 | (define shadow-south-east (read-bitmap shadow-south-east-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/shadow-south-west.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/shadow-south-west.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/shadow-south-west.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide shadow-south-west) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path shadow-south-west-img "shadow-south-west.png") 5 | (define shadow-south-west (read-bitmap shadow-south-west-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/shadow-south.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/shadow-south.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/shadow-south.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide shadow-south) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path shadow-south-img "shadow-south.png") 5 | (define shadow-south (read-bitmap shadow-south-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/shadow-west.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/shadow-west.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/shadow-west.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide shadow-west) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path shadow-west-img "shadow-west.png") 5 | (define shadow-west (read-bitmap shadow-west-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/speech-bubble.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/speech-bubble.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/speech-bubble.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide speech-bubble) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path speech-bubble-img "speech-bubble.png") 5 | (define speech-bubble (read-bitmap speech-bubble-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/stone-block-tall.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/stone-block-tall.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/stone-block-tall.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide stone-block-tall) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path stone-block-tall-img "stone-block-tall.png") 5 | (define stone-block-tall (read-bitmap stone-block-tall-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/stone-block.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/stone-block.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/stone-block.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide stone-block) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path stone-block-img "stone-block.png") 5 | (define stone-block (read-bitmap stone-block-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/tree-short.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/tree-short.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/tree-short.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide tree-short) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path tree-short-img "tree-short.png") 5 | (define tree-short (read-bitmap tree-short-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/tree-tall.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/tree-tall.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/tree-tall.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide tree-tall) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path tree-tall-img "tree-tall.png") 5 | (define tree-tall (read-bitmap tree-tall-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/tree-ugly.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/tree-ugly.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/tree-ugly.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide tree-ugly) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path tree-ugly-img "tree-ugly.png") 5 | (define tree-ugly (read-bitmap tree-ugly-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/wall-block-tall.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/wall-block-tall.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/wall-block-tall.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide wall-block-tall) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path wall-block-tall-img "wall-block-tall.png") 5 | (define wall-block-tall (read-bitmap wall-block-tall-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/wall-block.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/wall-block.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/wall-block.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide wall-block) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path wall-block-img "wall-block.png") 5 | (define wall-block (read-bitmap wall-block-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/water-block.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/water-block.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/water-block.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide water-block) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path water-block-img "water-block.png") 5 | (define water-block (read-bitmap water-block-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/window-tall.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/window-tall.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/window-tall.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide window-tall) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path window-tall-img "window-tall.png") 5 | (define window-tall (read-bitmap window-tall-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/wood-block.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/wood-block.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/wood-block.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide wood-block) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path wood-block-img "wood-block.png") 5 | (define wood-block (read-bitmap wood-block-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/yellow-star.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/planetcute/yellow-star.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/planetcute/yellow-star.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide yellow-star) 3 | (require racket/draw racket/runtime-path) 4 | (define-runtime-path yellow-star-img "yellow-star.png") 5 | (define yellow-star (read-bitmap yellow-star-img)) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/private/csv/friends.csv: -------------------------------------------------------------------------------- 1 | Binoche,Ste. Brune,33-1-2-3 2 | Posey,Main St.,555-5309 3 | Ryder,Cellblock 9, 4 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/private/csv/fruit.csv: -------------------------------------------------------------------------------- 1 | apples | 2 | 0.42 2 | bananas | 20 | 13.69 3 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/private/csv/permission.txt: -------------------------------------------------------------------------------- 1 | From: Neil Van Dyke 2 | Date: April 13, 2010 2:39:54 PM EDT 3 | To: Matthias Felleisen 4 | Subject: Re: csv package 5 | 6 | Matthias, sure, you guys may include it, if you want to. 7 | 8 | I have to retain copyright, since it's used by people with several non-PLT Scheme implementations. 9 | 10 | If LGPL 3 license is a problem, and you're looking for a LPGL 2.x, I could change the license. 11 | 12 | I've attached a ".zip" file of the sources of the latest version.  PLaneT has the sources for the specific version you mentioned.  Let me know if you need something else. 13 | 14 | Cheers, 15 | Neil 16 | 17 | Matthias Felleisen wrote at 04/13/2010 11:08 AM: 18 | 19 | Neil, would it be okay with you if I provide your csv package from the core: 20 | 21 |  (require (planet neil/csv:1:2/csv)) 22 | 23 | If so, could you send me your sources? Thanks -- Matthias 24 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/private/design.txt: -------------------------------------------------------------------------------- 1 | Files for constructing universe.rkt: 2 | 3 | world.rkt the old world 4 | world% = (clock-mixin ...) -- the basic world 5 | aworld% = (class world% ...) -- the world with recording 6 | 7 | universe.rkt the universe server 8 | universe% = (clock-mixin ...) -- the basic universe 9 | 10 | timer.rkt the clock-mixin 11 | 12 | check-aux.rkt common primitives 13 | image.rkt the world image functions 14 | clauses-spec-and-process.rkt syntactic auxiliaries 15 | clauses-spec-aux.rkt auxiliaries to the syntactic auxiliaries 16 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/private/gamepad.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/private/gamepad.png -------------------------------------------------------------------------------- /htdp-lib/2htdp/private/image-core.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | ;; this is here as a backwards compatibility file to provide the snipclass 3 | (require mrlib/image-core) 4 | (provide snip-class) 5 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/private/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define test-responsibles '(("img-err.rkt" robby) 4 | ("image-more.rkt" robby) 5 | ("image-core.rkt" robby))) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/private/last.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/gui 2 | 3 | (require "timer.rkt") 4 | 5 | (provide last-mixin) 6 | 7 | (define last-mixin 8 | (mixin (start-stop<%>) () 9 | ;; to comunicate between stop! and last 10 | (field [end:ch (make-channel)]) 11 | 12 | ;; X -> Void 13 | (define/override (stop! w) 14 | (send-to-last w) 15 | (super stop! w)) 16 | 17 | ;; -> World 18 | (define/public (last) 19 | (define result (yield end:ch)) 20 | (if (exn? result) (raise result) result)) 21 | 22 | (field [dr:cust (current-custodian)]) 23 | 24 | ;; X -> Void 25 | ;; send x to last method 26 | (define/private (send-to-last x) 27 | (parameterize ((current-custodian dr:cust)) 28 | (thread 29 | (lambda () 30 | (channel-put end:ch x))))) 31 | 32 | (super-new))) 33 | 34 | 35 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/private/pad.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/gui 2 | 3 | ;; provide basic elements for game pad clause in big-bang: the icon, pad-event? 4 | 5 | (require mrlib/include-bitmap) 6 | 7 | (provide 8 | ;; bitmap 9 | game-pad 10 | ;; KeyEvent -> Boolean 11 | ;; is the given key-event also a pad-event? 12 | pad-event? 13 | ;; PadEvent PadEvent -> Boolean 14 | ;; are the two pad-events equal? 15 | pad=? 16 | ) 17 | 18 | ;; --------------------------------------------------------------------------------------------------- 19 | 20 | (define game-pad (include-bitmap "gamepad.png" 'png/alpha)) 21 | (unless (send game-pad ok?) 22 | (error 'big-bang "the game pad icon isn't available; please report error")) 23 | 24 | (define pad-buttons 25 | '("up" "w" 26 | "down" "s" 27 | "left" "a" 28 | "right" "d" 29 | " " 30 | "shift" "rshift")) 31 | 32 | (define (pad-event? ke) 33 | (pair? (member ke pad-buttons))) 34 | 35 | (define (pad=? ke kq) 36 | (and (pad-event? ke) (pad-event? kq) (string=? ke kq))) 37 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/private/stop.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme 2 | 3 | (provide (struct-out stop-the-world)) 4 | 5 | (define-struct stop-the-world (world) #:transparent) 6 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/private/utilities.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/contract) 4 | 5 | (provide/contract 6 | ;; like the unix debugging facility 7 | [tee (-> symbol? any/c any)] 8 | ) 9 | 10 | 11 | (define (tee tag x) 12 | (printf "~a ~s\n" tag x) 13 | x) 14 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/uchat/auxiliaries.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme 2 | 3 | (provide spawn) 4 | 5 | (define (spawn f name) 6 | (thread (lambda () (f name)))) 7 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/uchat/xrun: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | gracket server.rkt & 4 | gracket chatter.rkt -e"(run* 'go)" & 5 | -------------------------------------------------------------------------------- /htdp-lib/2htdp/universe-request.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/2htdp/universe-request.txt -------------------------------------------------------------------------------- /htdp-lib/2htdp/web-io.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; show an X-expression in the browser 4 | 5 | ;; ----------------------------------------------------------------------------- 6 | ;; services 7 | 8 | (provide 9 | ;; X-expression -> String 10 | ;; converts the given X-expression to a String 11 | ;; EFFECT sends the String to an external browser 12 | show-in-browser) 13 | 14 | ;; ----------------------------------------------------------------------------- 15 | ;; dependencies 16 | 17 | (require (only-in net/sendurl send-url/contents)) 18 | (require (only-in xml/xml xexpr? xexpr->string)) 19 | (require htdp/error) 20 | 21 | ;; ----------------------------------------------------------------------------- 22 | ;; implementation 23 | 24 | (define (show-in-browser x) 25 | (check-the-argument x (xexpr? x)) 26 | (define x-as-string (xexpr->string x)) 27 | (send-url/contents x-as-string #true) 28 | x-as-string) 29 | 30 | ;; Any Boolean [String] -> Void 31 | (define (check-the-argument x y [expected "X-expression"]) 32 | (check-arg 'show-in-browser y expected "first" x)) -------------------------------------------------------------------------------- /htdp-lib/LICENSE: -------------------------------------------------------------------------------- 1 | This component of Racket is distributed under the Apache 2.0 and MIT 2 | licenses. The user can choose the license under which they will be 3 | using the software. There may be other licenses within the 4 | distribution with which the user must also comply. 5 | 6 | See the files 7 | https://github.com/racket/racket/blob/master/racket/src/LICENSE-APACHE.txt 8 | and 9 | https://github.com/racket/racket/blob/master/racket/src/LICENSE-MIT.txt 10 | for the full text of the licenses. 11 | -------------------------------------------------------------------------------- /htdp-lib/graphics/graphics-unit.rkt: -------------------------------------------------------------------------------- 1 | (module graphics-unit mzscheme 2 | (require mzlib/unit 3 | mred/mred-sig 4 | "graphics-sig.rkt" 5 | "graphics-posn-less-unit.rkt") 6 | (provide graphics@) 7 | 8 | (define-unit p@ 9 | (import) 10 | (export graphics:posn^) 11 | (define-struct posn (x y))) 12 | 13 | (define-compound-unit/infer graphics@ 14 | (import mred^) 15 | (export graphics:posn^ graphics^) 16 | (link p@ graphics-posn-less@))) 17 | -------------------------------------------------------------------------------- /htdp-lib/graphics/graphics.rkt: -------------------------------------------------------------------------------- 1 | (module graphics mzscheme 2 | (require mzlib/unit 3 | mred/mred-sig 4 | mred/mred-unit 5 | "graphics-sig.rkt" 6 | "graphics-unit.rkt") 7 | (provide-signature-elements graphics^ graphics:posn^) 8 | 9 | (define-values/invoke-unit/infer 10 | (export graphics^ graphics:posn^) 11 | (link standard-mred@ graphics@))) 12 | -------------------------------------------------------------------------------- /htdp-lib/graphics/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define test-responsibles '((all (mflatt robby)))) 4 | -------------------------------------------------------------------------------- /htdp-lib/graphics/main.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require "graphics.rkt") 4 | (provide (all-from-out "graphics.rkt")) 5 | -------------------------------------------------------------------------------- /htdp-lib/graphics/private/value-turtles-wxme.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require wxme 3 | racket/class 4 | racket/list 5 | "value-turtles-reader.rkt") 6 | (provide reader 7 | wxme-turtle? 8 | wxme-turtle->snip) 9 | 10 | (define reader 11 | (new 12 | (class* object% (snip-reader<%>) 13 | (define/public (read-header version stream) (void)) 14 | (define/public (read-snip text-only? version stream) 15 | (wxme-turtle 16 | (vec->struc 17 | (read 18 | (open-input-bytes 19 | (send stream read-raw-bytes "value-turtles-snip")))))) 20 | (super-new)))) 21 | 22 | (struct wxme-turtle (exp)) 23 | (define (wxme-turtle->snip turtle-snip% tv) 24 | (cond 25 | [(wxme-turtle? tv) 26 | (define sexp (wxme-turtle-exp tv)) 27 | (cond 28 | [(= (length sexp) 5) 29 | (make-object turtle-snip% 30 | (first sexp) 31 | (second sexp) 32 | (third sexp) 33 | (fourth sexp) 34 | (fifth sexp) 35 | 1)] 36 | [(= (length sexp) 6) 37 | (make-object turtle-snip% 38 | (first sexp) 39 | (second sexp) 40 | (third sexp) 41 | (fourth sexp) 42 | (fifth sexp) 43 | (sixth sexp))])] 44 | [else tv])) -------------------------------------------------------------------------------- /htdp-lib/graphics/tests/test-docs-complete.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require rackunit/docs-complete) 3 | (check-docs (quote graphics/value-turtles)) 4 | (check-docs (quote graphics/value-turtles-test)) 5 | (check-docs (quote graphics/value-turtles-examples)) 6 | (check-docs (quote graphics/turtles)) 7 | (check-docs (quote graphics/turtle-test)) 8 | (check-docs (quote graphics/turtle-examples)) 9 | (check-docs (quote graphics)) 10 | (check-docs (quote graphics/graphics)) 11 | (check-docs (quote graphics/graphics-unit)) 12 | (check-docs (quote graphics/graphics-sig)) 13 | (check-docs (quote graphics/graphics-posn-less-unit)) 14 | -------------------------------------------------------------------------------- /htdp-lib/htdp/asl/lang/reader.rkt: -------------------------------------------------------------------------------- 1 | #lang s-exp htdp/bsl/reader 2 | lang/htdp-advanced 3 | '(abbreviate-cons-as-list 4 | read-accept-quasiquote 5 | show-sharing 6 | disable-stepper 7 | enable-debugger) 8 | -------------------------------------------------------------------------------- /htdp-lib/htdp/bsl+/lang/reader.rkt: -------------------------------------------------------------------------------- 1 | #lang s-exp htdp/bsl/reader 2 | lang/htdp-beginner-abbr 3 | '(abbreviate-cons-as-list 4 | read-accept-quasiquote) 5 | -------------------------------------------------------------------------------- /htdp-lib/htdp/bsl/lang/reader.rkt: -------------------------------------------------------------------------------- 1 | #lang s-exp htdp/bsl/reader 2 | lang/htdp-beginner 3 | '() 4 | -------------------------------------------------------------------------------- /htdp-lib/htdp/bsl/print-width.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | ;; this parameter is used by the global port 4 | ;; print handler in the #lang htdp/* languages 5 | ;; in order to have a default that works better, 6 | ;; but to still give the opportunity to change it 7 | ;; in situations when that's needed. 8 | (define htdp-print-columns (make-parameter 'infinity)) 9 | (provide htdp-print-columns) -------------------------------------------------------------------------------- /htdp-lib/htdp/color-structs.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide (struct-out color) 3 | (struct-out alpha-color)) 4 | (define-struct color (red green blue) #:transparent) 5 | (define-struct alpha-color (alpha red green blue) #:transparent) 6 | -------------------------------------------------------------------------------- /htdp-lib/htdp/draw.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme 2 | 3 | (require htdp/big-draw 4 | htdp/draw-sig 5 | mzlib/unit) 6 | 7 | (define-syntax (draw s) 8 | (syntax-case s (produce) 9 | [(_ stmt ... produce exp) (syntax (begin (and stmt ...) exp))] 10 | [(_ stmt ... produce) 11 | (raise-syntax-error #f "produce must be followed by an expression" s)] 12 | [(_ stmt ... produce exp exp2) 13 | (raise-syntax-error #f "produce must be followed by exactly one expression" s)] 14 | [(_ stmt ... produce exp exp2 exp3) 15 | (raise-syntax-error #f "produce must be followed by exactly one expression" s)] 16 | [(_ stmt ...) 17 | (raise-syntax-error #f "use drawing instructions between _draw_ and _produce_ and an expression behind produce" s)] 18 | )) 19 | 20 | (provide 21 | draw ;; (draw ... produce ) 22 | ) 23 | 24 | (provide-signature-elements draw^) 25 | -------------------------------------------------------------------------------- /htdp-lib/htdp/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define name "HtDP Teachpacks") 4 | (define compile-omit-paths 5 | '("hangman-world.rkt" "hangman-world-play.rkt")) 6 | 7 | -------------------------------------------------------------------------------- /htdp-lib/htdp/isl+/lang/reader.rkt: -------------------------------------------------------------------------------- 1 | #lang s-exp htdp/bsl/reader 2 | lang/htdp-intermediate-lambda 3 | '(abbreviate-cons-as-list 4 | use-function-output-syntax 5 | read-accept-quasiquote) 6 | -------------------------------------------------------------------------------- /htdp-lib/htdp/isl/lang/reader.rkt: -------------------------------------------------------------------------------- 1 | #lang s-exp htdp/bsl/reader 2 | lang/htdp-intermediate 3 | '(abbreviate-cons-as-list 4 | read-accept-quasiquote) 5 | -------------------------------------------------------------------------------- /htdp-lib/htdp/master-play.rkt: -------------------------------------------------------------------------------- 1 | #cs(module master-play mzscheme 2 | (require 3 | "master.rkt" 4 | lang/prim) 5 | 6 | (provide go) 7 | (define-primitive go go/proc) 8 | 9 | (define (compare choice1 choice2 guess1 guess2) 10 | (cond 11 | [(and (eq? choice1 guess1) (eq? choice2 guess2)) 12 | 'perfect!] 13 | [(or (eq? choice1 guess1) (eq? choice2 guess2)) 14 | 'one_color_is_at_proper_place] 15 | [(or (eq? choice2 guess1) (eq? choice1 guess2)) 16 | 'one_color_occurs] 17 | [else 18 | 'sorry_all_wrong])) 19 | 20 | (define (go/proc s) 21 | (printf "Have fun playing, ~a\n" s) 22 | (master compare))) 23 | -------------------------------------------------------------------------------- /htdp-lib/htdp/matrix-invisible.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require htdp/matrix-sig 4 | htdp/matrix-render-sig 5 | htdp/matrix-unit) 6 | 7 | (define render@ 8 | (unit (import) 9 | (export matrix-render^) 10 | (define-struct invisible (matrix)) 11 | (define visible? invisible?) 12 | (define make-visible make-invisible) 13 | (define visible-matrix invisible-matrix))) 14 | 15 | (define invisible-matrix@ 16 | (compound-unit 17 | (import) 18 | (export m) 19 | (link (((r : matrix-render^)) render@) 20 | (((m : matrix^)) matrix@ r)))) 21 | 22 | (define-values/invoke-unit invisible-matrix@ (import) (export matrix^)) 23 | 24 | (provide-signature-elements matrix^) 25 | -------------------------------------------------------------------------------- /htdp-lib/htdp/matrix-render-sig.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/signature 2 | 3 | ;; type: [VM X] 4 | make-visible ;; [Matrix X] -> [VM X] 5 | 6 | visible-matrix ;; [VM X] -> [Matrix M] 7 | 8 | visible? ;; Any -> Boolean 9 | -------------------------------------------------------------------------------- /htdp-lib/htdp/testing.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require test-engine/racket-tests) 4 | 5 | (define (generate-report) (test)#;(void)) 6 | 7 | (provide (all-from-out test-engine/racket-tests) 8 | generate-report) 9 | -------------------------------------------------------------------------------- /htdp-lib/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection 'multi) 4 | 5 | (define deps 6 | '(["base" #:version "6.8.0.2"] 7 | "compatibility-lib" 8 | "draw-lib" 9 | ("drracket-plugin-lib" #:version "1.1") 10 | "errortrace-lib" 11 | "html-lib" 12 | "images-gui-lib" 13 | "images-lib" 14 | "net-lib" 15 | ["pconvert-lib" #:version "1.2"] 16 | "plai-lib" 17 | "r5rs-lib" 18 | "sandbox-lib" 19 | "scheme-lib" 20 | "scribble-lib" 21 | ["simple-tree-text-markup-lib" #:version "1.1"] 22 | "slideshow-lib" 23 | "snip-lib" 24 | "srfi-lite-lib" 25 | ["string-constants-lib" #:version "1.20"] 26 | "typed-racket-lib" 27 | "typed-racket-more" 28 | "web-server-lib" 29 | "wxme-lib" 30 | ("gui-lib" #:version "1.72") 31 | "deinprogramm-signature" 32 | "pict-lib")) 33 | (define build-deps '("racket-index" 34 | "at-exp-lib" 35 | ["rackunit-lib" #:version "1.10"])) 36 | 37 | (define pkg-desc "implementation (no documentation) part of \"htdp\"") 38 | 39 | (define pkg-authors '(matthias mflatt robby "sperber@deinprogramm.de")) 40 | 41 | (define version "1.8") 42 | 43 | (define license 44 | '(Apache-2.0 OR MIT)) 45 | -------------------------------------------------------------------------------- /htdp-lib/lang/htdp-advanced-reader.rkt: -------------------------------------------------------------------------------- 1 | (module htdp-advanced-reader mzscheme 2 | (require "htdp-reader.rkt") 3 | (provide (rename -read-syntax read-syntax) 4 | (rename -read read)) 5 | (define -read-syntax (make-read-syntax '(lib "htdp-advanced.ss" "lang"))) 6 | (define -read (make-read '(lib "htdp-advanced.ss" "lang")))) 7 | -------------------------------------------------------------------------------- /htdp-lib/lang/htdp-beginner-abbr-reader.rkt: -------------------------------------------------------------------------------- 1 | (module htdp-beginner-abbr-reader mzscheme 2 | (require "htdp-reader.rkt") 3 | (provide (rename -read-syntax read-syntax) 4 | (rename -read read)) 5 | (define -read-syntax (make-read-syntax '(lib "htdp-beginner-abbr.ss" "lang"))) 6 | (define -read (make-read '(lib "htdp-beginner-abbr.ss" "lang")))) 7 | -------------------------------------------------------------------------------- /htdp-lib/lang/htdp-beginner-reader.rkt: -------------------------------------------------------------------------------- 1 | (module htdp-beginner-reader mzscheme 2 | (require "htdp-reader.rkt") 3 | (provide (rename -read-syntax read-syntax) 4 | (rename -read read)) 5 | (define -read-syntax (make-read-syntax '(lib "htdp-beginner.ss" "lang"))) 6 | (define -read (make-read '(lib "htdp-beginner.ss" "lang")))) 7 | -------------------------------------------------------------------------------- /htdp-lib/lang/htdp-intermediate-lambda-reader.rkt: -------------------------------------------------------------------------------- 1 | (module htdp-intermediate-lambda-reader mzscheme 2 | (require "htdp-reader.rkt") 3 | (provide (rename -read-syntax read-syntax) 4 | (rename -read read)) 5 | (define -read-syntax (make-read-syntax '(lib "htdp-intermediate-lambda.ss" "lang"))) 6 | (define -read (make-read '(lib "htdp-intermediate-lambda.ss" "lang")))) 7 | -------------------------------------------------------------------------------- /htdp-lib/lang/htdp-intermediate-reader.rkt: -------------------------------------------------------------------------------- 1 | (module htdp-intermediate-reader mzscheme 2 | (require "htdp-reader.ss") 3 | (provide (rename -read-syntax read-syntax) 4 | (rename -read read)) 5 | (define -read-syntax (make-read-syntax '(lib "htdp-intermediate.ss" "lang"))) 6 | (define -read (make-read '(lib "htdp-intermediate.ss" "lang")))) 7 | -------------------------------------------------------------------------------- /htdp-lib/lang/htdp-langs-interface.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require racket/class) 3 | (provide htdp-language<%>) 4 | 5 | (define htdp-language<%> 6 | (interface () 7 | get-module 8 | get-language-position 9 | get-sharing-printing 10 | get-abbreviate-cons-as-list 11 | get-allow-sharing? 12 | get-use-function-output-syntax? 13 | get-accept-quasiquote? 14 | get-read-accept-dot)) -------------------------------------------------------------------------------- /htdp-lib/lang/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define name "HtDP Languages") 4 | (define tools (list "htdp-langs.rkt")) 5 | (define tool-icons (list '("htdp-icon.gif" "icons"))) 6 | (define tool-names (list "How to Design Programs")) 7 | (define tool-urls (list "http://www.htdp.org/")) 8 | 9 | (define compile-omit-paths 10 | '("test-error.rkt")) 11 | 12 | (define get-textbook-pls 13 | '("private/textbook-pls-spec.rkt" textbook-pls)) 14 | -------------------------------------------------------------------------------- /htdp-lib/lang/plt-pretty-big-text.rkt: -------------------------------------------------------------------------------- 1 | (module plt-pretty-big-text mzscheme 2 | (require mzlib/etc 3 | mzlib/file 4 | mzlib/list 5 | mzlib/class 6 | mzlib/unit 7 | mzlib/include 8 | mzlib/defmacro 9 | mzlib/pretty 10 | mzlib/string 11 | mzlib/thread 12 | mzlib/math 13 | mzlib/match 14 | mzlib/shared 15 | "posn.rkt") 16 | 17 | (provide (all-from mzscheme) 18 | (all-from mzlib/etc) 19 | (all-from mzlib/file) 20 | (all-from mzlib/list) 21 | (all-from mzlib/class) 22 | (all-from mzlib/unit) 23 | (all-from mzlib/include) 24 | (all-from mzlib/defmacro) 25 | (all-from mzlib/pretty) 26 | (all-from mzlib/string) 27 | (all-from mzlib/thread) 28 | (all-from mzlib/math) 29 | (all-from mzlib/match) 30 | (all-from mzlib/shared) 31 | (all-from "posn.rkt"))) 32 | -------------------------------------------------------------------------------- /htdp-lib/lang/plt-pretty-big.rkt: -------------------------------------------------------------------------------- 1 | (module plt-pretty-big "plt-pretty-big-text.rkt" 2 | (require mred "private/imageeq.rkt") 3 | 4 | (provide (all-from "plt-pretty-big-text.rkt") 5 | (all-from mred) 6 | (all-from "private/imageeq.rkt"))) 7 | -------------------------------------------------------------------------------- /htdp-lib/lang/private/continuation-mark-key.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (provide teaching-languages-continuation-mark-key) 4 | 5 | ; The test code also needs access to this. 6 | 7 | ;; cm-key : symbol 8 | ;; the key used to put information on the continuation 9 | (define teaching-languages-continuation-mark-key (gensym 'teaching-languages-continuation-mark-key)) 10 | -------------------------------------------------------------------------------- /htdp-lib/lang/private/imageeq.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require racket/snip 3 | mrlib/cache-image-snip 4 | (prefix-in 2htdp/image: mrlib/image-core) 5 | racket/class) 6 | 7 | (provide scene? image? image=? 8 | coerce-to-cache-image-snip 9 | snip-size 10 | bitmaps->cache-image-snip) 11 | 12 | (define (image? a) 13 | (or (is-a? a image-snip%) 14 | (is-a? a cache-image-snip%) 15 | (is-a? a 2htdp/image:image%))) 16 | 17 | (define (image=? a-raw b-raw) 18 | (unless (or (2htdp/image:image? a-raw) (image? a-raw)) (raise-type-error 'image=? "image" 0 a-raw b-raw)) 19 | (unless (or (2htdp/image:image? b-raw) (image? b-raw)) (raise-type-error 'image=? "image" 1 a-raw b-raw)) 20 | ;; Rely on image-snip% implementing equal<%>: 21 | (equal? a-raw b-raw)) 22 | 23 | (define (scene? i) 24 | (and (image? i) 25 | (not (is-a? i 2htdp/image:image%)) 26 | (let-values ([(x y) (send (coerce-to-cache-image-snip i) get-pinhole)]) 27 | (and (= 0 x) 28 | (= 0 y))))) 29 | -------------------------------------------------------------------------------- /htdp-lib/lang/private/set-result.rkt: -------------------------------------------------------------------------------- 1 | ;; this module is shared between drscheme's and the user's namespace 2 | ;; the printer uses it, printing it as (void), so that ordinary 3 | ;; (void) results can still be ignored by the printer. 4 | (module set-result mzscheme 5 | (provide set!-result) 6 | (define set!-result 7 | (let () 8 | (define-struct set!-result ()) 9 | (make-set!-result)))) 10 | 11 | -------------------------------------------------------------------------------- /htdp-lib/lang/private/teach-shared.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | (require (for-template racket/private/shared-body 3 | (only-in "teachprims.rkt" advanced-cons))) 4 | 5 | (provide shared/proc) 6 | 7 | (define code-insp 8 | (variable-reference->module-declaration-inspector 9 | (#%variable-reference))) 10 | 11 | (define shared/proc 12 | (lambda (stx make-check-cdr) 13 | (shared-body stx #'advanced-cons code-insp make-check-cdr))) 14 | -------------------------------------------------------------------------------- /htdp-lib/lang/private/textbook-pls-spec.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require string-constants) 3 | 4 | (provide textbook-pls) 5 | 6 | (define textbook-pls 7 | (list (list '("htdp-icon.gif" "icons") 8 | "How to Design Programs" 9 | (string-constant teaching-languages) 10 | "How to Design Programs" 11 | "Beginning Student"))) 12 | -------------------------------------------------------------------------------- /htdp-lib/lang/r5rs.rkt: -------------------------------------------------------------------------------- 1 | ;; This module provides R5RS Scheme, which is defined in "r5rs/main.rkt". 2 | ;; This file is here only as a stub for backward compatibility; use one 3 | ;; r5rs 4 | ;; instead. 5 | (module r5rs r5rs/main 6 | (#%provide (all-from r5rs/main))) 7 | -------------------------------------------------------------------------------- /htdp-lib/lang/stepper-language-interface.rkt: -------------------------------------------------------------------------------- 1 | (module stepper-language-interface mzscheme 2 | 3 | (require mzlib/class) 4 | (provide stepper-language<%>) 5 | 6 | (define stepper-language<%> 7 | (interface () 8 | stepper:supported? 9 | stepper:enable-let-lifting? 10 | stepper:show-lambdas-as-lambdas? 11 | stepper:show-inexactness? 12 | stepper:show-consumed-and/or-clauses? 13 | stepper:render-to-sexp))) 14 | -------------------------------------------------------------------------------- /htdp-lib/lang/test-error.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrScheme. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname bar) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) 4 | (check-error (error) "") 5 | (check-error (error 1) "1") 6 | (check-error (error 'a) "a: ") 7 | (check-error (error 'a "bad input") "a: bad input") 8 | (check-error (error 'a "bad input: " 1) "a: bad input: 1") 9 | (check-error (error 'a "bad input: " 1 " and " "hello") "a: bad input: 1 and hello") 10 | (check-error (error 'a "bad input: " 1 " and " false) "a: bad input: 1 and false") 11 | (check-error (error 'a "uhoh " (list 1 2 3)) "a: uhoh (cons 1 (cons 2 (cons 3 empty)))") 12 | 13 | (define-struct err (str)) 14 | 15 | (check-error (error 'a "bad input: " 1 " and " (make-err "hello")) 16 | "a: bad input: 1 and (make-err \"hello\")") 17 | -------------------------------------------------------------------------------- /htdp-lib/stepper/drracket-button.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | (require scheme/class string-constants/string-constant 3 | (prefix-in x: "private/step-img.rkt") 4 | (for-syntax racket/base)) 5 | (provide stepper-drracket-button stepper-button-callback) 6 | 7 | ; hack to make sure the key gets generated once at compile time, and 8 | ; not each time this module is instantiated 9 | (define-syntax (unique-member-name-key stx) 10 | (syntax-case stx () 11 | ((_) 12 | #`(member-name-key #,(gensym 'stepper-button-callback))))) 13 | 14 | (define-member-name stepper-button-callback (unique-member-name-key)) 15 | 16 | ; configure is a thunk to configure the runtime settings for printing values 17 | (define (stepper-drracket-button language settings configure) 18 | (list 19 | (string-constant stepper-button-label) 20 | x:step-img 21 | (λ (drs-frame) 22 | (configure) 23 | (define tab (send drs-frame get-current-tab)) 24 | (parameterize 25 | ;; make sure output, say from failed check-expects, goes into the REPL 26 | ((current-output-port (send (send tab get-ints) get-out-port))) 27 | (send tab stepper-button-callback language settings))))) 28 | -------------------------------------------------------------------------------- /htdp-lib/stepper/examples/bobby.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (for/list ([z 13]) 4 | z) 5 | -------------------------------------------------------------------------------- /htdp-lib/stepper/examples/external-interface-example.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require stepper/external-interface 4 | stepper/private/marks 5 | racket/runtime-path) 6 | 7 | ;; this handler just prints out some information about 8 | ;; the topmost mark in the list. 9 | (define (handler mark-list kind value-list) 10 | (printf "handling a break\n") 11 | (printf "break kind: ~s\n" kind) 12 | (when mark-list 13 | (printf "~a" (display-mark (first mark-list))) 14 | (define source (mark-source (first mark-list))) 15 | (printf "top-mark line: ~s\n" (syntax-line source)) 16 | (printf "top-mark column: ~s\n" (syntax-column source))) 17 | (when value-list 18 | (printf "values in value-list:\n") 19 | (for ([v value-list]) 20 | (printf "~s\n" v))) 21 | (newline)) 22 | 23 | ;; the string interface: 24 | (step-program-string "globby" 25 | "#lang racket 26 | (+ 3 4)" 27 | handler) 28 | 29 | ;; the file interface: 30 | (define-runtime-path bobby "./bobby.rkt") 31 | 32 | (expand-and-print (path->stx bobby)) 33 | 34 | (step-program-file bobby handler) 35 | -------------------------------------------------------------------------------- /htdp-lib/stepper/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define drracket-tools '(("stepper+xml-tool.rkt"))) 4 | 5 | (define drracket-tool-names (list "The Stepper")) 6 | 7 | (define drracket-tool-icons (list '("stepper-32x32.png" "icons"))) 8 | 9 | (define release-note-files (list (list "Stepper" "HISTORY.txt"))) 10 | 11 | (define test-responsibles '((all clements))) 12 | -------------------------------------------------------------------------------- /htdp-lib/stepper/private/beginner-defined.rkt: -------------------------------------------------------------------------------- 1 | (module beginner-defined mzscheme 2 | (provide must-reduce) 3 | 4 | (define must-reduce 5 | `(e pi))) 6 | -------------------------------------------------------------------------------- /htdp-lib/stepper/private/step-img.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require images/compile-time 3 | (for-syntax images/icons/control 4 | images/icons/style 5 | racket/base)) 6 | (provide step-img) 7 | ;; the bitmap to use in a horizontal or vertical toolbar: 8 | (define step-img (compiled-bitmap (step-icon #:color run-icon-color #:height (toolbar-icon-height)))) 9 | -------------------------------------------------------------------------------- /htdp-lib/stepper/private/syntax-hider.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; this file exists entirely to hide syntax objects ... and 4 | ;; marks ... from Typed 5 | ;; Racket. Hopefully we can remove this wrapper once there are 6 | ;; chaperones for Syntax objects. 7 | 8 | 9 | (provide (struct-out sstx) 10 | (struct-out smrk)) 11 | 12 | ;; hides a syntax object from TR: 13 | (struct sstx (s) #:transparent) 14 | 15 | ;; hides a mark from TR 16 | (struct smrk (m) #:transparent) -------------------------------------------------------------------------------- /htdp-lib/stepper/private/vertical-separator-snip.rkt: -------------------------------------------------------------------------------- 1 | (module vertical-separator-snip mzscheme 2 | (require mred 3 | mzlib/class 4 | "mred-extensions.rkt") 5 | 6 | (provide snip-class) 7 | (define snip-class (make-object vertical-separator-snip-class%)) 8 | (send snip-class set-classname (format "~s" `(lib "vertical-separator-snip.ss" "stepper" "private"))) 9 | (send (get-the-snip-class-list) add snip-class)) 10 | -------------------------------------------------------------------------------- /htdp-lib/stepper/private/xml-sig.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/signature 2 | 3 | xml-snip% scheme-snip% 4 | -------------------------------------------------------------------------------- /htdp-lib/stepper/stepper+xml-tool.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/unit 4 | drracket/tool 5 | "stepper-tool.rkt" 6 | "xml-tool.rkt" 7 | "private/view-controller.rkt") 8 | 9 | (provide tool@) 10 | 11 | ;; the xml and stepper tools are combined, so that the stepper can create XML 12 | ;; snips. 13 | 14 | (define tool@ 15 | (compound-unit/infer 16 | (import drracket:tool^) 17 | (export STEPPER-TOOL) 18 | (link xml-tool@ 19 | view-controller@ 20 | [((STEPPER-TOOL : drracket:tool-exports^)) stepper-tool@]))) 21 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/2htdp/abstraction.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (provide (all-from-out 2htdp/abstraction)) 3 | (require 2htdp/abstraction) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/2htdp/batch-io.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme 2 | (provide (all-from-out 2htdp/batch-io)) 3 | (require 2htdp/batch-io) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/2htdp/image.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide (all-from-out 2htdp/image)) 3 | (require 2htdp/image) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/2htdp/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define 2htdp-teachpacks 'all) 4 | 5 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/2htdp/itunes.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (provide (all-from-out 2htdp/itunes)) 3 | (require 2htdp/itunes) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/2htdp/universe.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (provide (all-from-out 2htdp/universe)) 3 | (require 2htdp/universe) -------------------------------------------------------------------------------- /htdp-lib/teachpack/2htdp/web-io.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (provide (all-from-out 2htdp/web-io)) 3 | (require 2htdp/web-io) -------------------------------------------------------------------------------- /htdp-lib/teachpack/balls.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/teachpack/balls.gif -------------------------------------------------------------------------------- /htdp-lib/teachpack/data.csv: -------------------------------------------------------------------------------- 1 | hello, world 2 | good, bye 3 | i, am, done 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/data.txt: -------------------------------------------------------------------------------- 1 | hello world 2 | good bye 3 | i am done 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/arrow-gui.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/arrow-gui) 3 | (provide (all-from-out htdp/arrow-gui)) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/arrow.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/arrow) 3 | (provide (all-from-out htdp/arrow)) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/convert.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/convert) 3 | (provide (all-from-out htdp/convert)) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/dir.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/dir) 3 | (provide (all-from-out htdp/dir)) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/docs.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/docs) 3 | (provide (all-from-out htdp/docs)) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/draw.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/draw) 3 | (provide (all-from-out htdp/draw)) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/elevator.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/elevator) 3 | (provide (all-from-out htdp/elevator)) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/graphing.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/graphing) 3 | (provide (all-from-out htdp/graphing)) 4 | (module test racket/base) 5 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/guess-gui.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/guess-gui) 3 | (provide (all-from-out htdp/guess-gui)) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/guess.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/guess) 3 | (provide (all-from-out htdp/guess)) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/gui.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/gui) 3 | (provide (all-from-out htdp/gui)) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/hangman.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/hangman) 3 | (provide (all-from-out htdp/hangman)) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/image.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/image lang/prim) 3 | (provide (all-from-out htdp/image)) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define htdp-teachpacks 'all) 4 | 5 | 6 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/lkup-gui.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/lkup-gui) 3 | (provide (all-from-out htdp/lkup-gui)) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/master.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/master) 3 | (provide (all-from-out htdp/master)) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/matrix.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/matrix) 3 | (provide (all-from-out htdp/matrix)) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/servlet.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/servlet) 3 | (provide (all-from-out htdp/servlet)) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/servlet2.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/servlet2) 3 | (provide (all-from-out htdp/servlet2)) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/show-queen.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/show-queen) 3 | (provide (all-from-out htdp/show-queen)) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/testing.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/testing) 3 | (provide (all-from-out htdp/testing)) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/htdp/world.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require htdp/world) 3 | (provide (all-from-out htdp/world)) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define release-note-files (list (list "Teachpacks" "HISTORY.txt"))) 4 | 5 | (define test-responsibles '((all matthias))) 6 | 7 | (define test-omit-paths (list "balls.ss")) 8 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/tests/test-docs-complete.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require rackunit/docs-complete) 3 | (check-docs (quote teachpack/world)) 4 | (check-docs (quote teachpack/value-turtles)) 5 | (check-docs (quote teachpack/turtles)) 6 | (check-docs (quote teachpack/server)) 7 | (check-docs (quote teachpack/picturing-programs)) 8 | (check-docs (quote teachpack/nuworld)) 9 | (check-docs (quote teachpack/door)) 10 | (check-docs (quote teachpack/balls)) 11 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/turtles.ss: -------------------------------------------------------------------------------- 1 | (module turtles mzscheme 2 | (require graphics/turtles) 3 | (provide (all-from graphics/turtles))) 4 | -------------------------------------------------------------------------------- /htdp-lib/teachpack/value-turtles.ss: -------------------------------------------------------------------------------- 1 | (module value-turtles mzscheme 2 | (require graphics/value-turtles) 3 | (provide (all-from graphics/value-turtles))) 4 | -------------------------------------------------------------------------------- /htdp-lib/test-engine/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define tools (list (list "test-tool.rkt"))) 4 | (define tool-names '("Test Engine")) 5 | -------------------------------------------------------------------------------- /htdp-lib/test-engine/scheme-tests.rkt: -------------------------------------------------------------------------------- 1 | ; For backwards compatibility. 2 | #lang racket/base 3 | (require "racket-tests.rkt") 4 | (provide (all-from-out "racket-tests.rkt")) 5 | 6 | -------------------------------------------------------------------------------- /htdp-lib/test-engine/srcloc.rkt: -------------------------------------------------------------------------------- 1 | ; Extract a srcloc from an exception, provided the right continuation-mark keys are present. 2 | #lang racket/base 3 | (provide exn-srcloc continuation-marks-srcloc) 4 | 5 | (require lang/private/continuation-mark-key 6 | setup/collects) 7 | 8 | ; return srcloc associated with exception, in user program, or #f 9 | (define (exn-srcloc exn) 10 | (if (exn:srclocs? exn) 11 | (let ([srclocs ((exn:srclocs-accessor exn) exn)]) 12 | (and (pair? srclocs) 13 | (car srclocs))) 14 | (continuation-marks-srcloc (exn-continuation-marks exn)))) 15 | 16 | (define (continuation-marks-srcloc marks) 17 | (let ([cms (continuation-mark-set->list marks teaching-languages-continuation-mark-key)]) 18 | (cond 19 | [(not cms) '()] 20 | [(findf (lambda (mark) 21 | (and mark 22 | (let ([ppath (car mark)]) 23 | (or (and (path? ppath) 24 | (not (let ([rel (path->collects-relative ppath)]) 25 | (and (pair? rel) 26 | (eq? 'collects (car rel)) 27 | (or (equal? #"lang" (cadr rel)) 28 | (equal? #"deinprogramm" (cadr rel))))))) 29 | (symbol? ppath))))) 30 | cms) 31 | => (lambda (mark) 32 | (apply (lambda (source line col pos span) 33 | (make-srcloc source line col pos span)) 34 | mark))] 35 | (else #f)))) 36 | -------------------------------------------------------------------------------- /htdp-lib/typed/test-engine/racket-tests.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require test-engine/racket-tests 4 | "type-env-ext.rkt") 5 | (provide (all-from-out test-engine/racket-tests)) 6 | -------------------------------------------------------------------------------- /htdp-lib/typed/test-engine/scheme-tests.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require test-engine/scheme-tests 4 | "type-env-ext.rkt") 5 | (provide (all-from-out test-engine/scheme-tests)) 6 | -------------------------------------------------------------------------------- /htdp-lib/xml/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | ;; the XML tool has been moved to the stepper collection, so that the 4 | ;; stepper can create xml snips. See collects/stepper/tool.rkt for (a 5 | ;; bit) more information 6 | (define tools '(("text-box-tool.rkt"))) 7 | (define tool-names '("Text Box")) 8 | -------------------------------------------------------------------------------- /htdp-lib/xml/scheme-snipclass.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require stepper/private/xml-snip-helpers 3 | mzlib/class 4 | mred) 5 | 6 | (provide snip-class scheme-snip%) 7 | 8 | (define scheme-snip% 9 | (class* editor-snip% (scheme-snip<%> readable-snip<%>) 10 | (init-field splice?) 11 | (define/public (get-splice?) splice?) 12 | 13 | (define/public (read-special file line col pos) 14 | (scheme-read-special this 15 | file 16 | line 17 | col 18 | pos)) 19 | 20 | (super-instantiate ()))) 21 | 22 | (define scheme-snipclass% 23 | (class snip-class% 24 | (define/override (read stream-in) 25 | (let* ([splice? (zero? (send stream-in get-exact))] 26 | [snip (instantiate scheme-snip% () 27 | (splice? splice?))]) 28 | (send (send snip get-editor) read-from-file stream-in #f) 29 | snip)) 30 | (super-instantiate ()))) 31 | 32 | (define snip-class (make-object scheme-snipclass%)) 33 | (send snip-class set-version 1) 34 | (send snip-class set-classname (format "~s" '(lib "scheme-snipclass.rkt" "xml"))) 35 | (send (get-the-snip-class-list) add snip-class) 36 | -------------------------------------------------------------------------------- /htdp-lib/xml/xml-snipclass.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require stepper/private/xml-snip-helpers 3 | mzlib/class 4 | mred) 5 | 6 | (provide snip-class xml-snip%) 7 | 8 | (define xml-snip% 9 | (class* editor-snip% (xml-snip<%> readable-snip<%>) 10 | (init-field eliminate-whitespace-in-empty-tags?) 11 | 12 | (define/public (read-special file line col pos) 13 | (xml-read-special eliminate-whitespace-in-empty-tags? 14 | this 15 | file 16 | line 17 | col 18 | pos)) 19 | 20 | (super-new))) 21 | 22 | (define xml-snipclass% 23 | (class snip-class% 24 | (define/override (read stream-in) 25 | (let* ([eliminate-whitespace-in-empty-tags? (zero? (send stream-in get-exact))] 26 | [snip (instantiate xml-snip% () 27 | (eliminate-whitespace-in-empty-tags? eliminate-whitespace-in-empty-tags?))]) 28 | (send (send snip get-editor) read-from-file stream-in #f) 29 | snip)) 30 | (super-new))) 31 | 32 | (define snip-class (make-object xml-snipclass%)) 33 | (send snip-class set-version 1) 34 | (send snip-class set-classname (format "~s" '(lib "xml-snipclass.rkt" "xml"))) 35 | (send (get-the-snip-class-list) add snip-class) 36 | -------------------------------------------------------------------------------- /htdp-lib/xml/xml.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-lib/xml/xml.png -------------------------------------------------------------------------------- /htdp-test/2htdp/TESTME.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-test/2htdp/TESTME.txt -------------------------------------------------------------------------------- /htdp-test/2htdp/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define compile-omit-paths 4 | '("tests" "uchat" "utest")) -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/.gitignore: -------------------------------------------------------------------------------- 1 | /images0/ 2 | /images3/ 3 | /batch-io.txt 4 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/abstraction-errors.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/load 2 | 3 | (require rackunit) 4 | 5 | (define-syntax-rule 6 | (exn/msg m e) 7 | (check-exn 8 | (lambda (x) 9 | (and (exn:fail:syntax? x) 10 | (regexp-match m (exn-message x)))) 11 | (lambda () 12 | (eval `(module a racket/base (require ,ABSTRACTION) e))))) 13 | 14 | (define ABSTRACTION '2htdp/abstraction) 15 | 16 | (exn/msg "bad syntax" (for/list 10)) 17 | (exn/msg "expected at least one comprehension clause" (for/list () 10)) 18 | (exn/msg "expected comprehension clause" (for/list (x) 10)) 19 | (exn/msg "expected identifier" (for/list (((x y) z)) 10)) 20 | (exn/msg "expected identifier" (for/list ([10 10]) 10)) 21 | (exn/msg "expected identifier" (for/list ([(+ 1 1) 10]) 10)) 22 | (exn/msg "unexpected term" (for/list ([x 1]) 10 10)) 23 | (exn/msg "expected comprehension clause" (for/list ([y 2] x) 10)) 24 | (exn/msg "expected identifier" (for/list ([y 2][(+ 1 1) 10]) 10)) 25 | (exn/msg "expected identifier" (for/list ([x 1] ([(x y) a z])) 10)) 26 | (exn/msg "expected identifier" (for/list ([x 1][10 x]) 10)) 27 | 28 | 29 | (exn/msg "expected structure definition" (match 1 [(var x) x])) 30 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/bad-draw.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme 2 | 3 | (require 2htdp/universe) 4 | 5 | (define txt "expected to return a scene but this is a string") 6 | 7 | (with-handlers ((exn? (lambda (e) (unless (string=? (exn-message e) txt) (raise e))))) 8 | (big-bang 0 9 | (on-tick add1) 10 | (to-draw (lambda (w) (error txt))))) 11 | 12 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/batch-io-csv-ho.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname batch-io-csv-ho) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | (require 2htdp/batch-io) 5 | 6 | (check-expect (read-csv-file/rows "batch-io-csv-ho.txt" length) (cons 3 empty)) 7 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/batch-io-csv-ho.txt: -------------------------------------------------------------------------------- 1 | a,b,c 2 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/batch-io-xexpr-enumeration.xml: -------------------------------------------------------------------------------- 1 |
    2 |
    • 3 |
    • 4 |
      • 5 |
      • 6 |
    7 |
    • 8 |
    • 9 |
    • 10 |
11 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/batch-io-xexpr-machine.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/batch-io2.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; test for pr11445 4 | 5 | (require 2htdp/batch-io) 6 | 7 | (define file "batch-io2.txt") 8 | 9 | (with-output-to-file file 10 | (lambda () 11 | (display "hello") 12 | (display #\return) 13 | (display #\linefeed)) 14 | #:exists 'replace) 15 | 16 | (require rackunit) 17 | (check-equal? (read-lines "batch-io2.txt") '("hello")) 18 | 19 | (when (file-exists? file) 20 | (delete-file file)) 21 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/bitmap-as-image-in-universe.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require pict (only-in 2htdp/universe big-bang on-tick to-draw) "test-aux.rkt") 4 | 5 | (testing 6 | (check-equal? 7 | 103 8 | (big-bang 100 9 | [on-tick add1 1/28 3] 10 | [to-draw (lambda (w) (pict->bitmap (circle w)))]))) 11 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/check-with-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; makes sure check-with produces a good error message 4 | ;; (I am clueless as to why this broke.) 5 | 6 | (require 2htdp/image) 7 | (require 2htdp/universe) 8 | 9 | (define (trivial x) 10 | (overlay x (empty-scene 300 200))) 11 | 12 | (define msg 13 | #px"the initial expression evaluated to .*, which fails to pass check-with's number\\? test") 14 | 15 | (with-handlers ([exn:fail? (lambda (xn) (unless (regexp-match msg (exn-message xn)) (raise xn)))]) 16 | (big-bang (circle 10 "solid" "blue") 17 | (check-with number?) 18 | (on-draw trivial))) 19 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/close-on-stop.rkt: -------------------------------------------------------------------------------- 1 | #lang htdp/isl+ 2 | 3 | (require 2htdp/universe) 4 | (require 2htdp/image) 5 | 6 | (define (test close? final) 7 | (big-bang 3 8 | (to-draw (lambda (x) (circle (+ (* x 10) 100) 'solid 'red))) 9 | (on-tick sub1) 10 | (stop-when zero? final) 11 | (close-on-stop close?))) 12 | 13 | (test #false (lambda (x) (text "this one remained open" 22 'black))) 14 | (test 3 (lambda (x) (text "this one will close on its own" 22 'green))) 15 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/error-in-draw.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require 2htdp/universe 2htdp/image "test-aux.rkt") 4 | 5 | (define (f x) 6 | (cond 7 | [(= x 0) (circle 10 'solid 'red)] 8 | [(= x 1) (circle 20 'solid 'red)] 9 | [else (error txt)])) 10 | 11 | (define txt "all questions were #f") 12 | 13 | (testing 14 | 15 | (with-handlers ([exn? (lambda (e) (unless (string=? (exn-message e) txt) (raise e)))]) 16 | (big-bang 0 (on-tick add1) (to-draw f)) 17 | (error 'error-in-draw "test failed")) 18 | 19 | 20 | (let ([exn (with-handlers ([exn:fail? values]) 21 | (big-bang #f 22 | [to-draw (λ (a b) #f)]) 23 | "no error raised")]) 24 | (unless (regexp-match #rx"^to-draw:" (exn-message exn)) 25 | (eprintf "expected a error message beginning with to-draw:\n") 26 | (raise exn))) 27 | 28 | (let ([exn (with-handlers ([exn:fail? values]) 29 | (big-bang #f 30 | [on-draw (λ (a b) #f)]) 31 | "no error raised")]) 32 | (unless (regexp-match #rx"^on-draw:" (exn-message exn)) 33 | (eprintf "expected a error message beginning with on-draw:\n") 34 | (raise exn)))) 35 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/error-in-tick.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require 2htdp/universe 2htdp/image "test-aux.rkt") 4 | 5 | (define (f x) (circle 10 'solid 'red)) 6 | 7 | (define (g x) 8 | (cond 9 | [(= x 0) 1] 10 | [else (error txt)])) 11 | 12 | (define txt "all questions were #f") 13 | 14 | (testing 15 | (with-handlers ([exn? (lambda (e) (unless (string=? (exn-message e) txt) (raise e)))]) 16 | (big-bang 0 (on-tick g) (to-draw f)) 17 | (error 'error-in-tick "test failed"))) 18 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/error-messages.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require 2htdp/universe) 4 | 5 | (with-handlers ((exn:fail:contract? 6 | (lambda (x) 7 | (unless (regexp-match "make-package" (exn-message x)) 8 | (raise x))))) 9 | (make-package 1 2 3)) 10 | 11 | (with-handlers ((exn:fail:contract? 12 | (lambda (x) 13 | (unless (regexp-match "make-bundle" (exn-message x)) 14 | (raise x))))) 15 | (make-bundle 1 2)) 16 | 17 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/full-scene-visible.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/base 2 | 3 | (require 2htdp/universe 4 | "test-aux.rkt" 5 | (prefix-in 2: 2htdp/image) 6 | (prefix-in 1: htdp/image)) 7 | 8 | (define (see-full-rectangle x f) 9 | (big-bang x 10 | (on-tick sub1) 11 | (stop-when zero?) 12 | (on-draw (λ (x) (f 100 100 'outline 'black))))) 13 | 14 | (testing 15 | (see-full-rectangle 3 2:rectangle) 16 | (see-full-rectangle 3 1:rectangle)) 17 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/full-test-width-height.rkt: -------------------------------------------------------------------------------- 1 | #lang htdp/asl 2 | 3 | (require 2htdp/universe) 4 | (require 2htdp/image) 5 | 6 | (define-struct world [size width height]) 7 | ;; World = (make-world Number [Maybe Number] [Maybe Number]) 8 | 9 | ;; World Number -> World 10 | (define (update-size w s) 11 | (make-world s (world-width w) (world-height w))) 12 | 13 | ;; {'fullscreen, 'normal} -> Number 14 | (define (main x) 15 | (big-bang (make-world 900 #false #false) 16 | (to-draw (lambda (x) 17 | (local ((define width (world-width x))) 18 | (if (boolean? width) 19 | (circle (+ 20 (world-size x)) 'solid 'red) 20 | (overlay 21 | (rectangle (* .20 width) (* .20 (world-height x)) 'solid 'blue) 22 | (circle (+ 20 (world-size x)) 'solid 'red)))))) 23 | (on-tick (lambda (x) (update-size x (- (world-size x) 20)))) 24 | (stop-when (lambda (w) (< (world-size w) 0))) 25 | (display-mode x 26 | ;; optional function to pick up the extent of the world 27 | (lambda (w width height) (make-world (world-size w) width height))) 28 | (close-on-stop #true))) 29 | 30 | (main 'fullscreen) 31 | (main 'normal) 32 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/full-test.rkt: -------------------------------------------------------------------------------- 1 | #lang htdp/isl+ 2 | 3 | (require 2htdp/universe) 4 | (require 2htdp/image) 5 | 6 | ;; {'fullscreen, 'normal} -> Number 7 | (define (main x) 8 | (big-bang 900 9 | (to-draw (lambda (x) (circle (+ 20 x) 'solid 'red))) 10 | (on-tick (lambda (x) (- x 20))) 11 | (stop-when (lambda (x) (< x 0))) 12 | (close-on-stop #true) 13 | (display-mode x))) 14 | 15 | (main 'fullscreen) 16 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/image-too-large.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require 2htdp/universe 2htdp/image "test-aux.rkt") 4 | 5 | (define width 100000) 6 | (define height 10) 7 | (define image (rectangle width height 'solid 'red)) 8 | (define small (rectangle 100 100 'solid 'black)) 9 | 10 | (define (draw-large i) 11 | image) 12 | 13 | (testing 14 | (check-true 15 | (with-handlers ([exn:fail? (lambda (x) 16 | (define msg (exn-message x)) 17 | (define reg (regexp-match "draw-large" msg)) 18 | (pair? reg))]) 19 | (big-bang 1 20 | (to-draw draw-large) 21 | (on-tick sub1) 22 | (stop-when zero?)) 23 | #false)) 24 | 25 | (check-true 26 | (with-handlers ([exn:fail? (lambda (x) 27 | (define msg (exn-message x)) 28 | (define reg (regexp-match "to-draw" msg)) 29 | (pair? reg))]) 30 | (big-bang 0 31 | (to-draw draw-large width height) 32 | (on-tick add1) 33 | (stop-when zero?)) 34 | #false)) 35 | 36 | (check-true 37 | (local ((define first-time #true)) 38 | (big-bang 0 39 | (to-draw (lambda (_) (begin0 (if first-time small image) (set! first-time #false)))) 40 | (on-tick add1) 41 | (stop-when zero?)) 42 | #true))) 43 | 44 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define test-omit-paths 4 | '("jpr-bug.rkt" 5 | "mouse-evt.rkt" 6 | "mp.rkt" 7 | "perform-whack.rkt" 8 | "profile-robby.rkt" 9 | "dir.rkt" 10 | "matrix-client.rkt" 11 | "matrix-example.rkt" 12 | "jump-to-ui-test.rkt" 13 | "on-release-no-key.rkt" 14 | "pad1.rkt" 15 | "universe-receive.rkt" 16 | "world-dies-while-receiving.rkt" 17 | "batch-io-xexpr.rkt" 18 | "stop-when-bad-draw.rkt" 19 | "close-on-stop.rkt")) 20 | 21 | (define test-responsibles '(("test-image.rkt" robby) 22 | ("image-equality-performance.rkt" robby) 23 | ("image-equality-performance-htdp.rkt" robby))) 24 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/jpr-bug.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-advanced-reader.ss" "lang")((modname jpr-bug) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ()))) 4 | 5 | ;; This program demonstrated that the idea of using default handlers (K) for 6 | ;; absent mouse and key handlers was a horrible idea. The balls on his cannvas 7 | ;; just started jumping around when the mouse moved in. 8 | 9 | (require 2htdp/universe) 10 | (require 2htdp/image) 11 | 12 | 13 | (define (animation2) 14 | (local [(define SIZE 300) 15 | (define SCENE (rectangle SIZE SIZE 'outline "black")) 16 | (define dM 1) 17 | (define INIT 0) 18 | (define (suivant m) 19 | (+ m dM)) 20 | (define (dessiner m) 21 | (place-image (circle m 'solid "red") (random SIZE) (random SIZE) SCENE))] 22 | (big-bang INIT 23 | (on-tick suivant 1) 24 | (on-draw dessiner SIZE SIZE)))) 25 | 26 | (animation2) 27 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/lauch-many-worlds-proc.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; --------------------------------------------------------------------------------------------------- 4 | ;; testing launch many worlds/proc 5 | 6 | (require 2htdp/universe 2htdp/image) 7 | 8 | (define (aworld x c) 9 | (big-bang 10 10 | [to-draw (lambda (i) (text (number->string x) (+ 33 i) c))] 11 | [on-tick sub1] 12 | [stop-when zero?])) 13 | 14 | (define (main) 15 | (apply launch-many-worlds/proc 16 | (build-list 20 (lambda (x) (lambda () (aworld (+ 10 x) (make-color 255 255 x))))))) 17 | 18 | (main) 19 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/mp.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme (require test-engine/racket-tests) 2 | (require 2htdp/universe) 3 | (require htdp/image) 4 | 5 | 6 | ;; WorldState = Image 7 | 8 | ;; graphical constants 9 | (define mt (empty-scene 100 100)) 10 | 11 | ;; clack : WorldState Nat Nat String -> Worldstate 12 | ;; add a dot at (x,y) to ws 13 | 14 | (check-expect 15 | (clack mt 10 20 "button-down") 16 | (place-image (circle 1 "solid" "red") 10 20 mt)) 17 | 18 | (check-expect 19 | (clack (place-image (circle 1 "solid" "red") 1 2 mt) 3 3 "button-down") 20 | (place-image (circle 1 "solid" "red") 3 3 21 | (place-image (circle 1 "solid" "red") 1 2 mt))) 22 | 23 | (define (clack ws x y action) 24 | (if (string=? "button-down" action) 25 | (place-image (circle 1 "solid" "red") x y ws) 26 | ws)) 27 | 28 | ;; show : WorldState -> WorldState 29 | ;; just reveal the current world state 30 | 31 | (check-expect (show mt) mt) 32 | 33 | (define (show ws) 34 | ws) 35 | 36 | (test) 37 | 38 | ;; run program run 39 | (define (main x) 40 | (big-bang (empty-scene 100 100) 41 | (on-draw show) 42 | (record? x) 43 | (on-mouse clack))) 44 | 45 | (main false) 46 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/name.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; created in response to pr 12857 4 | ;; make sure the name of a world is transmitted to the server 5 | 6 | (require rackunit) 7 | (require 2htdp/universe) 8 | (require 2htdp/image) 9 | 10 | (define NAME 'ian-johnson) 11 | 12 | (define c (make-custodian)) 13 | 14 | ;; Distinct from other tests: 15 | (define PORT-NO 19206) 16 | 17 | (define-values (_ n) 18 | (parameterize ((current-custodian c)) 19 | (launch-many-worlds 20 | ;; --- world: 21 | (big-bang 10 22 | (on-tick sub1) 23 | (to-draw (lambda (w) (empty-scene 200 200))) 24 | (name NAME) 25 | (register LOCALHOST) 26 | (port PORT-NO)) 27 | ;; --- universe: 28 | (universe #f 29 | (on-new (lambda (u w) (make-bundle (iworld-name w) '() '()))) 30 | (on-msg (lambda (u w m) (make-bundle u '() '()))) 31 | (on-tick (lambda (u) (make-bundle u '() '())) 1 1) 32 | (port PORT-NO))))) 33 | 34 | (check-equal? n NAME) 35 | 36 | (custodian-shutdown-all c) 37 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/on-release-no-key.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-advanced-reader.ss" "lang")((modname on-release-no-key) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ()))) 4 | ;; Any key inflates the balloon 5 | 6 | (require 2htdp/image) 7 | (require 2htdp/universe) 8 | (require "test-aux.rkt") 9 | 10 | (define large 50) 11 | 12 | (define (balloon b) 13 | (if (<= b 10) 14 | (text "press any key now" 22 'red) 15 | (circle b "solid" "red"))) 16 | 17 | (define (blow-up b k) large) 18 | 19 | (define (deflate b) (max (- b 1) 1)) 20 | 21 | (testing 22 | (big-bang 20 23 | (on-release blow-up) 24 | (on-tick deflate) 25 | (to-draw balloon 200 200) 26 | (stop-when (lambda (w) (>= w large))))) 27 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/on-tick-universe-with-limit.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require 2htdp/universe 2htdp/image) 4 | 5 | (universe 0 6 | (on-tick (lambda (w) (make-bundle (add1 w) '() '())) 1/28 3) 7 | (on-msg (lambda (w sender msg) (make-bundle w '() '()))) 8 | (on-new cons) 9 | ;; Distinct from other tests: 10 | (port 19207)) 11 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/on-tick-with-limit.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require 2htdp/universe 2htdp/image "test-aux.rkt") 4 | 5 | (testing 6 | (big-bang 0 7 | (on-tick add1 1/28 3) 8 | (to-draw (lambda (w) (circle (- 100 w) 'solid 'red))))) 9 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/pad1-handler.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require 2htdp/universe) 4 | 5 | ;; ----------------------------------------------------------------------------- 6 | ;; test case 7 | 8 | (define (i-sub1 x) (- x 0+1i)) 9 | (define (i-add1 x) (+ x 0+1i)) 10 | 11 | (define handler 12 | (pad-handler (left sub1) 13 | (right add1) 14 | (up i-sub1) 15 | (down i-add1) 16 | (shift (lambda (w) 0)) 17 | (space stop-with))) 18 | 19 | (define-syntax-rule 20 | (tst (=-fun (handler in s) expe)) 21 | (let* ((actual (handler in s))) 22 | (unless (=-fun actual expe) 23 | (error 'test "~a failed [in: ~a expected: ~a actual: ~a]" s in expe actual)))) 24 | 25 | (tst (= (handler 9 "left") 8)) 26 | (tst (= (handler 8 "right") 9)) 27 | (tst (= (handler 8 "up") 8-i)) 28 | (tst (= (handler 8 "down") 8+i)) 29 | 30 | (tst (= (handler 9 "a") 8)) 31 | (tst (= (handler 8 "d") 9)) 32 | (tst (= (handler 8 "w") 8-i)) 33 | (tst (= (handler 8 "s") 8+i)) 34 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/pad1-in-bsl.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname pad1-in-bsl) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) 4 | ;; must stay in BSL 5 | 6 | (require 2htdp/universe) 7 | (require 2htdp/image) 8 | (require "test-aux.rkt") 9 | 10 | (define (render x) 11 | (place-image (circle 3 'solid 'red) (+ 150 (real-part x)) (+ 150 (imag-part x)) (empty-scene 300 300))) 12 | 13 | (define (sub1-i x) (- x 0+i)) 14 | (define (add1-i x) (+ x 0+i)) 15 | 16 | (testing 17 | (big-bang 0+0i 18 | (to-draw render) 19 | (on-tick add1-i 1/28 50) 20 | (on-pad (pad-handler (up sub1-i) (down add1-i) (left sub1) (right add1))))) 21 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/perform-robby.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme 2 | (require 2htdp/universe 2htdp/image "test-aux.rkt") 3 | 4 | (define (slow) 5 | (let sloop ([n (expt 2 22)]) 6 | (unless (zero? n) 7 | (sloop (- n 1))))) 8 | 9 | (define (update-world w) 10 | (slow) 11 | (- w 1)) 12 | 13 | (define (render w) 14 | (circle 30 'solid (if (odd? w) 'red 'green))) 15 | 16 | (testing 17 | (big-bang 10 18 | (on-tick update-world) 19 | (on-draw render) 20 | (stop-when zero?)) 21 | 22 | (printf "done\n")) 23 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/planetcute-runs.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (require 2htdp/planetcute) 3 | character-cat-girl -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/profile-robby.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme/gui 2 | (require profile 3 | scheme/runtime-path) 4 | 5 | (define-runtime-path perform-robby "perform-robby.rkt") 6 | 7 | (profile-thunk 8 | (λ () 9 | (parameterize ([current-eventspace (make-eventspace)]) 10 | (let ([s (make-semaphore 0)]) 11 | (queue-callback 12 | (λ () 13 | (dynamic-require perform-robby #f) 14 | (semaphore-post s))) 15 | (semaphore-wait s)))) 16 | #:threads #t) 17 | 18 | 19 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/proper-hiilite-in-hash-lang.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/gui 2 | 3 | (require rackunit) 4 | (require 2htdp/universe) 5 | (require 2htdp/image) 6 | 7 | (define ground 350) 8 | (define-struct ufo (height velocity)) 9 | 10 | (define UFO 11 | (underlay/align "center" 12 | "center" 13 | (circle 10 "solid" "green") 14 | (rectangle 40 4 "solid" "green"))) 15 | 16 | (define explosion (star-polygon 20 10 3 "solid" "red")) 17 | 18 | (define (create-UFO-scene my-ufo) 19 | (underlay/xy (rectangle 100 100 "solid" "white") 50 (ufo-height my-ufo) UFO)) 20 | 21 | (define (last-picture my-ufo) 22 | (underlay/xy (rectangle 100 100 "solid" "white") 50 (ufo-height my-ufo) explosion)) 23 | 24 | (define (stop-expr my-ufo last-picture) 25 | (if (>= (ufo-height my-ufo) ground) #t #f)) 26 | 27 | (check-exn 28 | #px"stop-when: expected function of one argument as first argument; given function of 2 arguments" 29 | (lambda () 30 | (big-bang (make-ufo 0 1) ;start state 31 | (to-draw create-UFO-scene 400 400) 32 | (stop-when stop-expr last-picture)))) 33 | 34 | (displayln "hilite last claise, and repor") 35 | 36 | #; 37 | (big-bang (make-ufo 0 1) ;start state 38 | (to-draw create-UFO-scene 400 400) 39 | (stop-when stop-expr last-picture)) 40 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/random-seed-works.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; testing the combination of random-seed and world programming 4 | ;; ----------------------------------------------------------------------------- 5 | 6 | (require 2htdp/universe 2htdp/image) 7 | 8 | (define (main) 9 | (random-seed 1324) 10 | (big-bang 11 | '() 12 | #; 13 | (on-tick (λ (l) (cons (random 100) l)) 1/100 30) 14 | ;; it fails mostly with just time but not always, strange 15 | 16 | (to-draw (λ (l) 17 | (text (if (> (length l) 3) 18 | "ok" 19 | (~a "press a again: " (- 2 (length l)))) 20 | 222 21 | *color))) 22 | 23 | (on-key (λ (l ke) 24 | (if (and (key=? "a" ke) (<= (length l) 3)) (cons (random 100) l) l))) 25 | 26 | (stop-when (λ (l) (>= (length l) 2))))) 27 | 28 | (define *color 'blue) 29 | 30 | ;; ----------------------------------------------------------------------------- 31 | (require "test-aux.rkt") 32 | 33 | (testing 34 | (check-equal? (main) (begin (set! *color 'red) (main)))) 35 | 36 | ;; disable in drdr 37 | (module test racket/base) 38 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/release.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme 2 | 3 | (require 2htdp/universe 2htdp/image "test-aux.rkt") 4 | 5 | (define (main r) 6 | (big-bang 1 7 | (on-draw (lambda (n) 8 | (if (string? n) 9 | (text (string-append "stopped: " n) 11 'red) 10 | (text "hold down a" 11 'blue))) 11 | 500 500) 12 | (on-tick (lambda (x) (if (string? x) x (add1 x))) 13 | r) 14 | (stop-when (lambda (x) 15 | (if (string? x) 16 | (>= (string-length x) 3) 17 | (>= x 5)))) 18 | (on-key (lambda (n key) 19 | (if (string? n) 20 | (string-append n key) 21 | (if (key=? "a" key) 22 | "" 23 | n)))) 24 | (on-release (lambda (n key) 25 | ;; you can release a key only if it was pressed 26 | (if (key=? "a" key) 27 | 1 28 | n))))) 29 | (testing (main 1)) 30 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/run-movie.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require 2htdp/universe 2htdp/image "test-aux.rkt") 4 | 5 | (define (make-images i) 6 | (cond 7 | [(zero? i) '()] 8 | [else (cons (place-image DOT 50 (* 50 i) BACKGROUND) (make-images (sub1 i)))])) 9 | 10 | (define DOT (circle 3 'solid 'red)) 11 | (define BACKGROUND (empty-scene 100 400)) 12 | 13 | (testing (run-movie 1/8 (make-images 8))) 14 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/server-rename.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require (prefix-in uni: 2htdp/universe)) 4 | 5 | (define (server) 6 | (uni:universe 0 7 | (uni:on-new cons) 8 | (uni:on-msg list) 9 | (uni:on-tick add1) 10 | ;; Distinct from other tests: 11 | (uni:port 19204))) 12 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/stop-when-bad-draw.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-advanced-reader.ss" "lang")((modname stop-when-bad-draw) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #t #t none #f () #f))) 4 | (require 2htdp/image) 5 | (require 2htdp/universe) 6 | 7 | (define (main x) 8 | (big-bang x 9 | [to-draw draw-circ] 10 | [on-tick shrink-circ] 11 | [stop-when stop-circ?])) 12 | 13 | (define (draw-circ x) (circle x 'solid" 'red")) 14 | (define (shrink-circ x) (- x 5)) 15 | (define (stop-circ? x) (<= x 0)) 16 | 17 | (check-expect (main 2) -3) -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/stop-when-crash.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; --------------------------------------------------------------------------------------------------- 4 | ;; the stop-when clause crashes. make sure that it signals a catchable error. 5 | 6 | (require 2htdp/universe 2htdp/image) 7 | 8 | (with-handlers ((exn:fail? void)) 9 | (big-bang 0 10 | (on-draw (λ _ (empty-scene 500 500))) 11 | (stop-when (λ _ (car '())))) 12 | (displayln '(*** something went wrong in stop-when crash ***))) 13 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/stop-when-error.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname stop-when-error) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) 4 | (require 2htdp/image) 5 | (require 2htdp/universe) 6 | 7 | (define (render x) (circle x "solid" "blue")) 8 | 9 | (check-error (big-bang 10 10 | (to-draw render) 11 | (on-tick sub1) 12 | (stop-when zero? (circle 10 "solid" "red"))) 13 | "stop-when: expected a function as second argument; given #") -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/stop-when-not-boolean.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; --------------------------------------------------------------------------------------------------- 4 | ;; the stop-when clause crashes. make sure that it signals a catchable error. 5 | 6 | (require 2htdp/universe 2htdp/image) 7 | 8 | (with-handlers ((exn:fail? (λ (x) 9 | (unless (pair? (regexp-match #px"return a boolean" (exn-message x))) 10 | (raise x))))) 11 | (big-bang 0 12 | (on-draw (λ _ (empty-scene 500 500))) 13 | (stop-when (λ _ 5))) 14 | (displayln '(*** SOMETHING WENT WRONG IN STOP-WHEN NOT BOOLEAN ***))) 15 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/stop.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrScheme. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname stop) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) 4 | (require 2htdp/universe) 5 | (require htdp/image) 6 | 7 | ;; on RETURN stop 8 | 9 | (define (main debug?) 10 | (big-bang "" 11 | (on-key (lambda (w ke) 12 | (cond 13 | [(key=? ke "\r") (stop-with w)] 14 | [(= (string-length ke) 1) 15 | (string-append w ke)] 16 | [else w]))) 17 | (state debug?) 18 | (on-draw (lambda (w) 19 | (place-image 20 | (text w 22 'black) 21 | 3 3 22 | (empty-scene 100 100)))))) 23 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/test-aux.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/gui 2 | 3 | (require rackunit) 4 | 5 | (provide 6 | ;; syntax 7 | ;; (testing e ...) creates a top-level test in its own eventspace that 8 | ;; shuts down after the tests are run 9 | testing 10 | (all-from-out rackunit)) 11 | 12 | ;; ----------------------------------------------------------------------------- 13 | 14 | (define-syntax-rule 15 | (testing e ...) 16 | (begin ;; module+ test 17 | (do-testing (lambda () e ...)))) 18 | 19 | (define (do-testing thunk) 20 | (parameterize ((current-eventspace (make-eventspace))) 21 | (define ch (make-channel)) 22 | (queue-callback 23 | (lambda () 24 | (with-handlers ([exn? (lambda (e) (channel-put ch e))]) 25 | (channel-put 26 | ch 27 | (call-with-values thunk list))))) 28 | (define r (channel-get ch)) 29 | (if (list? r) 30 | (apply values r) 31 | (raise r)))) 32 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/test-docs-complete.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require rackunit/docs-complete) 3 | (check-docs (quote 2htdp/universe)) 4 | (check-docs (quote 2htdp/universe-syntax-parse)) 5 | (check-docs (quote 2htdp/image)) 6 | (check-docs (quote 2htdp/batch-io)) 7 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/to-draw-error.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require 2htdp/universe rackunit) 4 | 5 | (check-equal? (with-handlers ((exn:fail:contract? exn-message)) 6 | (big-bang #f (to-draw (λ (_) '...) "not-a-number" "either"))) 7 | "to-draw: expects a natural number as width argument, given \"not-a-number\"") 8 | 9 | 10 | (check-equal? (with-handlers ((exn:fail:contract? exn-message)) 11 | (big-bang #f (to-draw (λ (_) '...) 100 "either"))) 12 | "to-draw: expects a natural number as height argument, given \"either\"") 13 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/two-universes-running.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; run two universes on the same port on localhost; make sure you gest 4 | ;; a sensible error 5 | 6 | (require 2htdp/universe) 7 | (require rackunit) 8 | 9 | (define (launch tag) 10 | (universe 0 11 | [on-tick (λ (x) (displayln `[tag ,x]) (sleep 1) (add1 x)) 1 3] 12 | [on-msg void] 13 | [on-new void])) 14 | 15 | (define my-custodian (make-custodian)) 16 | 17 | (parameterize ([current-custodian my-custodian] 18 | [current-error-port (open-output-string)]) 19 | (check-exn #px"the universe could not be created" 20 | (λ () 21 | (with-output-to-string 22 | (λ () 23 | (launch-many-worlds (launch 'one) (launch 'two))))) 24 | "spawn two universes")) 25 | 26 | (custodian-shutdown-all my-custodian) 27 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/u.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/racket/htdp/a4809bca0895dd4ccaecceff335fbb93057c1623/htdp-test/2htdp/tests/u.png -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/ufo-rename.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme 2 | (require (prefix-in uni: 2htdp/universe) 3 | (prefix-in uni: htdp/image) 4 | "test-aux.rkt") 5 | 6 | (define (create-UFO-scene height) 7 | (uni:place-image UFO 50 height (uni:empty-scene 100 100))) 8 | 9 | (define UFO 10 | (uni:overlay (uni:circle 10 'solid 'green) 11 | (uni:rectangle 40 4 'solid 'green))) 12 | 13 | (testing 14 | (uni:big-bang 0 15 | (uni:on-tick add1) 16 | (uni:stop-when (lambda (y) (>= y 100))) 17 | (uni:on-draw create-UFO-scene))) 18 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/web-io-automatic.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require 2htdp/web-io) 4 | 5 | ;; ----------------------------------------------------------------------------- 6 | ;; tests 7 | 8 | (require rackunit) 9 | 10 | (check-exn exn:fail? (lambda () (show-in-browser #f))) 11 | (check-exn exn:fail? 12 | (lambda () 13 | (show-in-browser '(html ([a 10]) (body (b "hello world")))))) 14 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/web-io-manual.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require 2htdp/web-io) 4 | 5 | ;; ----------------------------------------------------------------------------- 6 | ;; tests 7 | 8 | (require rackunit) 9 | 10 | (show-in-browser 11 | '(html () 12 | (body ([bgcolor "red"]) 13 | (b () 14 | "hello world" 15 | " " 16 | "does this")))) 17 | -------------------------------------------------------------------------------- /htdp-test/2htdp/tests/world-dies-while-receiving.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; When a world dies while receiving a message, universe's cleanup must work properly. 4 | ;; This lest sends a large byte string to the client and the client is going to close 5 | ;; down while receiving this message. 6 | 7 | (require 2htdp/universe 2htdp/image) 8 | 9 | (define long (make-bytes 10000000 11)) 10 | 11 | (define (uni) 12 | (universe '() 13 | [on-tick values 1 3] 14 | [on-new (lambda (worlds w) (make-bundle (cons w worlds) (list (make-mail w long)) '()))] 15 | [on-msg (lambda (worlds from msg) (make-bundle worlds '() '()))])) 16 | 17 | (define (cli) 18 | (big-bang 10 19 | [register LOCALHOST] 20 | [on-tick sub1 .1] 21 | [stop-when zero?] 22 | [on-receive (lambda (n msg) (displayln n (current-error-port)) n)] 23 | [to-draw (lambda (n) (text (number->string n) 44 'red))])) 24 | 25 | (launch-many-worlds (cli) (uni)) 26 | 27 | -------------------------------------------------------------------------------- /htdp-test/2htdp/utest/README: -------------------------------------------------------------------------------- 1 | 2 | to test: $ ./xrun 3 | to add a player: $ ./player Foo 4 | 5 | shared.ss : player infrastructure 6 | carl.ss : one specific player derived from shared.ss 7 | sam.ss : another one 8 | -- add more with player plus string 9 | 10 | balls.ss : the server 11 | 12 | -------------------------------------------------------------------------------- /htdp-test/2htdp/utest/design.txt: -------------------------------------------------------------------------------- 1 | 2 | Two collaboration worlds display a moving ball, one of them should rest. 3 | 4 | Pass Through (Distributed) Version 5 | ---------------------------------- 6 | 7 | Two screens pop up and a ball moves from the bottom to the top, on each of 8 | them. When one reaches the top, it rests and sends a signal to the other 9 | to 'go. This means only one of the worlds will have a moving ball, the 10 | other one rests. 11 | 12 | use ../pass-through.ss 13 | 14 | World and Messages: 15 | ;; World = Number | 'resting 16 | ;; Message = 'go 17 | 18 | Arbitrated Version 19 | ---------------------------------- 20 | 21 | Two screen pop up. The server sends one of them a go signal and the other 22 | one a rest signal. Until then both move so I can use the same shared 23 | code. 24 | 25 | use ball-universe.ss 26 | 27 | World and Messages: 28 | ;; World = Number | 'resting 29 | ;; ReceivedMessage = 'go 30 | ;; SendMessages = ... any token will do ... 31 | 32 | Server: 33 | ;; ReceivedMessages = ... any token will do ... 34 | ;; SendMessages = 'go 35 | -------------------------------------------------------------------------------- /htdp-test/2htdp/utest/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define test-omit-paths 4 | '("sam.rkt")) 5 | -------------------------------------------------------------------------------- /htdp-test/2htdp/utest/player: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | #| -*- scheme -*- 3 | exec mred -qu "$0" ${1+"$@"} 4 | |# 5 | 6 | #lang racket 7 | 8 | (require "shared.ss") 9 | 10 | (define argv (current-command-line-arguments)) 11 | 12 | (unless (= (vector-length argv) 1) 13 | (error 'player "name of one player expected: $ ./player name")) 14 | 15 | (make-player 200 (vector-ref argv 0)) 16 | -------------------------------------------------------------------------------- /htdp-test/2htdp/utest/sam.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname sam) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) 4 | (require "shared.rkt") 5 | (require 2htdp/universe) 6 | 7 | (launch-many-worlds (make-player 200 "sam") (make-player 100 "carl")) 8 | -------------------------------------------------------------------------------- /htdp-test/2htdp/utest/xrun: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | #| 3 | exec racket -t "$0" ${1+"$@"} 4 | |# 5 | 6 | #lang racket 7 | 8 | (require 2htdp/universe "balls.rkt" "shared.ss") 9 | 10 | (launch-many-worlds (run 'go) (make-player 200 "carl" #t) (make-player 200 "sam")) 11 | 12 | -------------------------------------------------------------------------------- /htdp-test/2htdp/xmanual: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | run() { 4 | exe="gracket" 5 | if [ "x$1" = "x-t" ]; then exe="racket"; shift; fi 6 | "$exe" "$1" 7 | echo "done:--- $1 ---" 8 | echo "" 9 | } 10 | 11 | cd tests 12 | 13 | run -t batch-io-xexpr.rkt 14 | run random-seed-works.rkt 15 | run mouse-evt.rkt 16 | run release.rkt 17 | run on-release-no-key.rkt 18 | run pad1.rkt 19 | # always keep this last because it doesn't shut down 20 | run close-on-stop.rkt 21 | run web-io-manual.rkt 22 | run proper-hiilite-in-hash-lang.rkt 23 | -------------------------------------------------------------------------------- /htdp-test/LICENSE: -------------------------------------------------------------------------------- 1 | This component of Racket is distributed under the Apache 2.0 and MIT 2 | licenses. The user can choose the license under which they will be 3 | using the software. There may be other licenses within the 4 | distribution with which the user must also comply. 5 | 6 | See the files 7 | https://github.com/racket/racket/blob/master/racket/src/LICENSE-APACHE.txt 8 | and 9 | https://github.com/racket/racket/blob/master/racket/src/LICENSE-MIT.txt 10 | for the full text of the licenses. 11 | -------------------------------------------------------------------------------- /htdp-test/htdp/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define name "HtDP Teachpack Tests") 4 | (define compile-omit-paths '("tests")) 5 | (define test-omit-paths '("tests/arrow-gui.rkt" 6 | "tests/arrow.rkt" 7 | "tests/draw.rkt" 8 | "tests/guess1.rkt" 9 | "tests/guess2.rkt" 10 | "tests/guess3.rkt" 11 | "tests/lkup-gui.rkt" 12 | "tests/master.rkt")) 13 | -------------------------------------------------------------------------------- /htdp-test/htdp/tests/TEST: -------------------------------------------------------------------------------- 1 | TEST: 2 | ---- 3 | 4 | * draw.ss 5 | * arrow.ss 6 | * arrow-gui.ss 7 | * convert.ss 8 | * dir.ss 9 | * docs.ss 10 | * elevator.ss 11 | * graphing.ss 12 | * guess1.ss 13 | * guess2.ss 14 | * guess3.ss 15 | * gui.ss 16 | * lkup-gui.ss 17 | * hangman1.ss 18 | * master.ss 19 | * matrix.ss 20 | -------------------------------------------------------------------------------- /htdp-test/htdp/tests/TODO: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------------- 2 | 3 | docs: 4 | 5 | ----------------------------------------------------------------------------------- 6 | code: 7 | 8 | General comment: 9 | the word repl should disappear 10 | 11 | guess.ss: repl, repl3, 12 | check that the result is a symbol gives bad error message 13 | 14 | master.ss 15 | add close? button 16 | 17 | hangman.ss 18 | error messages: can we do better? 19 | (test-error (hangman-list (lambda (x y z) x) first)) 20 | (test-error (hangman-list (lambda (x y z) x) list)) 21 | 22 | the game should be "start-once only" 23 | 24 | ----------------------------------------------------------------------------------- 25 | -------------------------------------------------------------------------------- /htdp-test/htdp/tests/arrow-gui.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrScheme. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname arrow-gui) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) 4 | (require htdp/arrow-gui) 5 | (require htdp/gui) 6 | 7 | (define (left b e) (draw-message msg "left")) 8 | (define (right b e) (draw-message msg "right")) 9 | (define (up b e) (draw-message msg "up")) 10 | (define (down b e) (draw-message msg "down")) 11 | 12 | (define msg (make-message (make-string 22 #\space))) 13 | (check-expect (window? (create-window (list (list msg)))) true) 14 | (check-expect (connect left right up down) true) 15 | -------------------------------------------------------------------------------- /htdp-test/htdp/tests/convert-drracket-error.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (require racket/runtime-path 3 | htdp/convert) 4 | 5 | (define-runtime-path non-error-pth "convert-drracket-non-error.txt") 6 | (define-runtime-path error-pth "convert-drracket-error.txt") 7 | 8 | (define (Fahrenheit->Celsius x) (* (/ 100 180) (- x 32))) 9 | 10 | (convert-file non-error-pth Fahrenheit->Celsius 11 | (build-path (find-system-path 'temp-dir) "out.dat")) 12 | 13 | (with-handlers ((exn:fail:read? void)) 14 | "The input file contains a bad header. The next line should raise an exn." 15 | (convert-file error-pth Fahrenheit->Celsius 16 | (build-path (find-system-path 'temp-dir) "out.dat")) 17 | (raise `(test "this test should have failed but didn't"))) 18 | -------------------------------------------------------------------------------- /htdp-test/htdp/tests/convert-drracket-error.txt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | ;; MATTHIAS ADDED THIS LINE TO BREAK THE BRITTLE ASSUMPTION IN HTDP/CONVERT. 4 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname convert-drracket-error) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) 5 | 6 | 214 7 | -------------------------------------------------------------------------------- /htdp-test/htdp/tests/convert-drracket-non-error.txt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname convert-drracket-non-error) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) 4 | 214 5 | -------------------------------------------------------------------------------- /htdp-test/htdp/tests/dir-aux.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide writeln natural-number/c regexp-match) -------------------------------------------------------------------------------- /htdp-test/htdp/tests/docs.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrScheme. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname docs) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) 4 | (require htdp/docs) 5 | 6 | (check-expect (annotation? ') true) 7 | (check-expect (annotation? 'html) false) 8 | (check-expect (annotation? '

) true) 9 | 10 | (check-expect (end-annotation ') ') 11 | 12 | (check-expect 13 | (write-file 14 | (list '

'hello 'world 'is 'the 'most 'stupid 'program 'in 'the 'world '

15 | "so let's test this" 'with "How's that")) 16 | true) 17 | -------------------------------------------------------------------------------- /htdp-test/htdp/tests/elevator.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrScheme. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname elevator) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) 4 | (require htdp/elevator) 5 | 6 | ;; next3 : (union 'up 'down) N X -> N 7 | ;; always sends elevator to next floor up or down, 8 | ;; switches direction at either end 9 | (define (next3 x y z) 10 | (cond 11 | ((and (eq? 'up x) (< y 8)) (+ y 1)) 12 | ((eq? 'up x) 7) ; anything down 13 | ((and (eq? 'down x) (> y 1)) (- y 1)) 14 | (else 2))) ; anything up 15 | 16 | (run next3) 17 | -------------------------------------------------------------------------------- /htdp-test/htdp/tests/graphing.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrScheme. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname graphing) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) 4 | (require htdp/graphing) 5 | 6 | (define (fun1 x) (+ (* x x) 1)) 7 | (check-expect (graph-fun fun1 'red) true) 8 | 9 | (define (fun2 x) (+ (* -1 x x) 1)) 10 | (check-expect (graph-fun fun2 'blue) true) 11 | 12 | (define (line1 x) (+ (* +1 x) 10)) 13 | (check-expect (graph-line line1 'black) true) 14 | 15 | (define (line2 x) (+ (* -1 x) 10)) 16 | (check-expect (graph-line line2 'green) true) 17 | -------------------------------------------------------------------------------- /htdp-test/htdp/tests/guess1.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrScheme. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname guess1) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) 4 | (require htdp/guess) 5 | 6 | ;; check-guess : number number -> symbol 7 | ;; to determine how guess and target relate to each other 8 | (define (check-guess guess target) 9 | (cond 10 | ((< target guess) 'TooLarge) 11 | ((= target guess) 'Perfect) 12 | ((> target guess) 'TooSmall))) 13 | 14 | ;; Tests: 15 | (eq? (check-guess 5000 5631) 'TooSmall) 16 | (eq? (check-guess 6000 5631) 'TooLarge) 17 | (eq? (check-guess 5631 5631) 'Perfect) 18 | 19 | ;; Test with GUI lib: set lib to guess-lib.ss 20 | (check-expect (guess-with-gui check-guess) true) 21 | 22 | ; (guess-with-gui list) 23 | ; (define (foo x) x) (guess-with-gui foo) 24 | ; (guess-with-gui first) 25 | -------------------------------------------------------------------------------- /htdp-test/htdp/tests/gui.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrScheme. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-advanced-reader.ss" "lang")((modname gui) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ()))) 4 | (require htdp/gui) 5 | 6 | ;; type in text, choose, click okay, watch message field change, close 7 | 8 | (define msg (make-message "Hello World")) 9 | 10 | (define txt (make-text "Enter your password please")) 11 | 12 | (define chc (make-choice (list "Choose something" "Or other"))) 13 | 14 | (define call-back 15 | (lambda (x) 16 | (begin 17 | (draw-message msg (format "~s ~s\n" (choice-index chc) (text-contents txt))) 18 | (draw-message msg "Bye World")))) 19 | 20 | (define (destroy x) (hide-window x)) 21 | 22 | (define w 23 | (create-window 24 | (list (list txt msg chc) 25 | (list (make-button "Okay?" call-back)) 26 | (list (make-button "Close" (lambda (x) (hide-window w))))))) 27 | 28 | -------------------------------------------------------------------------------- /htdp-test/htdp/tests/hangman-error.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-advanced-reader.ss" "lang")((modname hangman-error) (read-case-sensitive #t) (teachpacks ((lib "hangman.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ((lib "hangman.ss" "teachpack" "htdp"))))) 4 | (define (reveal-list chosen status guess) 5 | '(a)) 6 | 7 | (define (draw-next-part body-part) 8 | (begin 9 | "this revealed an omission in the teachpack" 10 | (printf "body-part ~s\n" body-part))) 11 | 12 | (start 200 200) 13 | (check-error (hangman-list reveal-list draw-next-part) 14 | "draw-next-part: is expected to return a boolean, but it returned (void)") 15 | -------------------------------------------------------------------------------- /htdp-test/htdp/tests/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define test-omit-paths 4 | '("convert.rkt" 5 | "elevator.rkt" 6 | "dir.rkt" 7 | "graphing.rkt" 8 | "gui.rkt" 9 | "hangman-error.rkt" 10 | "world-mouse.rkt" 11 | "matrix-client.rkt" 12 | "matrix-example.rkt")) 13 | 14 | (define test-responsibles '(("gui.rkt" robby))) 15 | -------------------------------------------------------------------------------- /htdp-test/htdp/tests/lkup-gui.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrScheme. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-advanced-reader.ss" "lang")((modname lkup-gui) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ()))) 4 | (require htdp/lkup-gui) 5 | 6 | (check-expect (connect 7 | (lambda (e b) 8 | (view (control)))) 9 | true) 10 | -------------------------------------------------------------------------------- /htdp-test/htdp/tests/master.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname master) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) 4 | (require htdp/master) 5 | 6 | ; (load "tester.rkt") 7 | 8 | ;; check-guess : color color color color -> symbol 9 | 10 | (define (check-guess target1 target2 guess1 guess2) 11 | (cond 12 | ((and (eq? target1 guess1) (eq? target2 guess2)) 13 | 'perfect) 14 | ((or (eq? target1 guess1) (eq? target2 guess2)) 15 | 'one_color-at_correct_position) 16 | ((or (eq? target1 guess2) (eq? target2 guess1)) 17 | 'the_colors_occur) 18 | (else 'nothing_correct))) 19 | 20 | ;; Tests: 21 | (eq? (check-guess 'white 'blue 'white 'blue) 'perfect) 22 | (eq? (check-guess 'white 'blue 'red 'blue) 'one_color-at_correct_position) 23 | (eq? (check-guess 'white 'blue 'blue 'red) 'the_colors_occur) 24 | (eq? (check-guess 'white 'blue 'red 'green) 'nothing_correct) 25 | 26 | (check-expect (master check-guess) true) 27 | -------------------------------------------------------------------------------- /htdp-test/htdp/tests/matrix-client-racket.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; a Racket (not *SL) client of the matrix library 4 | 5 | (require htdp/matrix) 6 | (require rackunit) 7 | 8 | (struct place [x] #:transparent #:property prop:procedure values) 9 | 10 | (check-false (equal? (build-matrix 1 1 (λ _ [place 'a])) (build-matrix 1 1 (λ _ [place 'b])))) 11 | (check-equal? (build-matrix 1 1 (λ _ [place 'a])) (build-matrix 1 1 (λ _ [place 'a]))) 12 | 13 | (define (M i) (build-matrix 1 1 (λ _ [place i]))) 14 | 15 | (check-false (equal? (M 'a) (M 'b))) 16 | (check-equal? (M 'a) (M 'a)) -------------------------------------------------------------------------------- /htdp-test/htdp/tests/tester.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme 2 | 3 | (provide test-error) 4 | 5 | (define-syntax test-error 6 | (lambda (stx) 7 | (syntax-case stx () 8 | [(_ form ...) 9 | (syntax 10 | (with-handlers ([exn? (lambda (e) 11 | (printf "~a\n" (exn-message e)) 12 | #t)]) 13 | form ... 14 | #f))]))) 15 | 16 | 17 | #| Tests: 18 | (not (test-error 1 2 3)) 19 | (test-error (/ 1 0) 2 3) 20 | |# 21 | -------------------------------------------------------------------------------- /htdp-test/htdp/tests/world-mouse.rkt: -------------------------------------------------------------------------------- 1 | #lang scheme 2 | 3 | (require htdp/world) 4 | 5 | (with-handlers ((exn? (lambda (x) #t))) 6 | (place-image (circle 3 'solid 'red) 1.2 3.14 (empty-scene 100 100))) 7 | 8 | (define (ms w x y e) 9 | (if (eq? e 'button-down) (list x y) w)) 10 | (define (rd w) 11 | (local ((define mt (empty-scene 300 300)) 12 | (define x1 (first w)) 13 | (define y1 (second w)) 14 | (define tx (text (format "(~s,~s)" x1 y1) 22 'red)) 15 | (define cr (circle 3 'solid 'red)) 16 | (define m1 (place-image tx 50 50 mt)) 17 | (define m2 (place-image cr x1 y1 m1))) 18 | m2)) 19 | (big-bang 300 300 1 (list 50 50)) 20 | (on-redraw rd) 21 | (on-mouse-event ms) 22 | -------------------------------------------------------------------------------- /htdp-test/htdp/tests/world.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #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 ()))) 4 | (require 2htdp/universe) 5 | (require htdp/image) 6 | 7 | ;; testing world 8 | ;; World = Nat 9 | 10 | (define world0 100) 11 | 12 | (define (world->image w) 13 | (place-image (circle 3 'solid 'red) 50 w (empty-scene 100 100))) 14 | 15 | (define (world->next w) (sub1 w)) 16 | 17 | (define (world->steer w ke) 18 | (cond 19 | [(char? ke) w] 20 | [(symbol=? ke 'left) 100] 21 | [(symbol=? ke 'right) 90] 22 | [else w])) 23 | 24 | ;; --- 25 | (check-expect (key-event? 'a) false) 26 | (check-expect (key-event? 0) false) 27 | (check-expect (key-event? "a") true) 28 | 29 | (check-expect (key=? "b" "a") false) 30 | 31 | (check-error (key=? "a" 0) "key=?: expects a KEY-EVTS as second argument, given 0") 32 | 33 | ;; run world run 34 | 35 | (define (main world0) 36 | (big-bang world0 37 | (on-draw world->image) 38 | (on-tick world->next) 39 | (on-key world->steer) 40 | (stop-when zero?))) 41 | -------------------------------------------------------------------------------- /htdp-test/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection 'multi) 4 | (define deps '("base" 5 | "htdp-lib")) 6 | (define build-deps '("lazy" 7 | "deinprogramm" 8 | "pict-lib" 9 | "simple-tree-text-markup-lib" 10 | "redex-lib" 11 | "racket-index" 12 | "scheme-lib" 13 | "compatibility-lib" 14 | "gui-lib" 15 | "racket-test" 16 | "rackunit-lib" 17 | "profile-lib" 18 | "wxme-lib" 19 | "pconvert-lib" 20 | "at-exp-lib" 21 | "drracket-tool-lib")) 22 | (define update-implies '("htdp-lib")) 23 | 24 | (define pkg-desc "tests for \"htdp\"") 25 | 26 | (define pkg-authors '(matthias mflatt robby "sperber@deinprogramm.de")) 27 | 28 | (define license 29 | '(Apache-2.0 OR MIT)) 30 | -------------------------------------------------------------------------------- /htdp-test/tests/htdp-lang/README: -------------------------------------------------------------------------------- 1 | The files in this directory test the teaching language implementation. 2 | 3 | test-htdp.rkt 4 | this module runs most of the tests 5 | 6 | test-image.rktl 7 | this module runs the htdp/image tests 8 | 9 | See beginner.rktl for more. 10 | -------------------------------------------------------------------------------- /htdp-test/tests/htdp-lang/beg-intm.rktl: -------------------------------------------------------------------------------- 1 | 2 | ;; For every test here, make sure the opposite test is in intml-adv.rkt 3 | 4 | (htdp-syntax-test #'(1 2 3) "function call: expected a function after the open parenthesis, but found a number") 5 | (htdp-syntax-test #'("hello" 1 2) "function call: expected a function after the open parenthesis, but found a string") 6 | 7 | (htdp-syntax-test #'(define x17 (lambda (y) (lambda (z) z))) "lambda: found a lambda that is not a function definition") 8 | (htdp-syntax-test #'(lambda (x) 10) "lambda: found a lambda that is not a function definition") 9 | 10 | (htdp-syntax-test #'(lambda (f) (f f)) "lambda: found a lambda that is not a function definition") 11 | 12 | (htdp-syntax-test #'(recur empty-f () 10) "recur: this function is not defined") 13 | 14 | (htdp-syntax-test #'((unquote-splicing (list 10))) "function call: expected a function after the open parenthesis, but found a part") 15 | 16 | (htdp-top (require 2htdp/abstraction)) 17 | (htdp-test 3 'posn-as-match-pattern (match (make-posn 1 2) [(posn x y) (+ x y)])) 18 | (htdp-top-pop 1) 19 | -------------------------------------------------------------------------------- /htdp-test/tests/htdp-lang/beg-intml.rktl: -------------------------------------------------------------------------------- 1 | 2 | ;; For every test here, make sure the opposite test is in advanced.rkt 3 | 4 | (htdp-syntax-test #'(define (xthnk) 10) "define: expected at least one variable after the function name, but found none") 5 | (htdp-syntax-test #'(define xthnk (lambda () 10)) "lambda: expected (lambda (variable more-variable ...) expression), but found no variables") 6 | 7 | (htdp-syntax-test #'(define x (lambda)) "lambda: expected (lambda (variable more-variable ...) expression), but nothing's there") 8 | (htdp-syntax-test #'(define x (lambda y)) "lambda: expected (lambda (variable more-variable ...) expression), but found something else") 9 | 10 | (htdp-err/rt-test (cons 1 2) "cons: second argument must be a list, but received 1 and 2") 11 | (htdp-err/rt-test (append (list 1) 2) "append: last argument must be a list, but received 2") 12 | -------------------------------------------------------------------------------- /htdp-test/tests/htdp-lang/beginner-abbr.rktl: -------------------------------------------------------------------------------- 1 | 2 | ;; Basic checks for the beginner language. Error messages really 3 | ;; should be inspected manually. 4 | 5 | ;; Limitations of this test suite: 6 | ;; - It doesn't check reader-level parameterization, such as use of quotes 7 | ;; - It doesn't check format of printed results 8 | ;; - It doesn't check the absence of Racket forms 9 | 10 | ;; Don't try to run other tests from the test suite after loading this 11 | ;; one into a particular namespace. 12 | 13 | (load-relative (collection-file-path "loadtest.rktl" "tests/racket")) 14 | 15 | ;; Don't need these: 16 | (define no-extra-if-tests? #t) 17 | 18 | (require (only-in mzscheme 19 | exn:fail? 20 | exn:fail:contract?)) 21 | 22 | (define current-htdp-lang 'lang/htdp-beginner-abbr) 23 | (load-relative "htdp-test.rktl") 24 | 25 | (require (lib "htdp-beginner-abbr.rkt" "lang")) 26 | 27 | (load-relative "beg-adv.rktl") 28 | (load-relative "beg-intml.rktl") 29 | (load-relative "beg-intm.rktl") 30 | (load-relative "beg-bega.rktl") 31 | (load-relative "bega-adv.rktl") 32 | 33 | (report-errs) 34 | -------------------------------------------------------------------------------- /htdp-test/tests/htdp-lang/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define test-responsibles '(("test-image.rkt" robby))) 4 | (define test-timeouts '(("test-htdp.rkt" 1500))) 5 | -------------------------------------------------------------------------------- /htdp-test/tests/htdp-lang/intm-intml.rktl: -------------------------------------------------------------------------------- 1 | 2 | (htdp-syntax-test #'(let name ([x 12]) 10) "let: expected at least one binding (in parentheses) after let, but found something else") 3 | 4 | (htdp-top (require "syntax.rkt")) 5 | 6 | (htdp-syntax-test #'(let-syntax ([#%app (lambda (stx) (raise-syntax-error #f "app fail" stx))]) 7 | (local [(define (x a b) 1)] 8 | (x 1 2))) 9 | "app fail") 10 | 11 | (htdp-top-pop 1) 12 | 13 | -------------------------------------------------------------------------------- /htdp-test/tests/htdp-lang/intm-lam.rktl: -------------------------------------------------------------------------------- 1 | (htdp-err/rt-test (map (lambda (x y) (+ x y)) (list 2 3 4)) 2 | (exn-type-and-msg 3 | exn:fail:contract? 4 | #rx"map: first argument must be a function that expects one argument")) 5 | 6 | (htdp-err/rt-test (foldr (lambda (x y) (+ x y)) 0 (list 2 3 4) (list 2 3 4)) 7 | (exn-type-and-msg 8 | exn:fail:contract? 9 | #rx"foldr: first argument must be a function that expects three arguments, given")) 10 | -------------------------------------------------------------------------------- /htdp-test/tests/htdp-lang/intmlam-adv.rktl: -------------------------------------------------------------------------------- 1 | 2 | (syntax-test #'(lambda (z z) 10)) 3 | 4 | (define f7 (lambda (y) (lambda (z) z))) 5 | (test #t procedure? f7) 6 | (test 778 (lambda (x) 778) 'ignored) 7 | 8 | (test values (lambda (f) (f f)) values) 9 | 10 | (define (f11 y) ((lambda (x) x) y)) 11 | (test 'id f11 'id) 12 | 13 | (err/rt-test (1 2 3)) 14 | 15 | (htdp-syntax-test #'(recur empty-f () 10) "recur: expected a function name after recur, but nothing's there" 16 | (htdp-syntax-test #'(local [(lambda (x) x)] 1) "local: expected a definition, but found a part") 17 | 18 | (htdp-syntax-test #'((unquote-splicing (list 10))) "unquote-splicing: misuse of ,@ or unquote-splicing, not under a quasiquoting backquote") 19 | 20 | 21 | 22 | -------------------------------------------------------------------------------- /htdp-test/tests/htdp-lang/pr/12117.rkt: -------------------------------------------------------------------------------- 1 | #lang htdp/asl 2 | 3 | (require racket/match) 4 | (define-struct a (b)) 5 | (match (make-a 1) [(struct a (b)) b] [#f 3]) 6 | -------------------------------------------------------------------------------- /htdp-test/tests/htdp-lang/prim.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (define (check-bad form) 4 | (with-handlers ([exn:fail? (lambda (exn) 5 | (define msg (exn-message exn)) 6 | (define mth (regexp-match #rx"y: unbound identifier" msg)) 7 | (unless mth (raise exn)))]) 8 | (expand form) 9 | (error 'check-bad "failed: ~v" form))) 10 | 11 | (define (check-good form) 12 | (void (expand form))) 13 | 14 | (check-bad `(,#'module m racket/base (require lang/prim) (define-primitive x y))) 15 | (check-bad `(,#'module m racket/base (require lang/prim) (provide-primitive y))) 16 | (check-good `(,#'module m racket/base (require lang/prim) (provide-primitive y) (define (y z) z))) 17 | 18 | -------------------------------------------------------------------------------- /htdp-test/tests/htdp-lang/syntax.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require (for-syntax racket/base)) 4 | (provide (for-syntax (all-from-out racket/base))) 5 | (provide let-syntax) 6 | -------------------------------------------------------------------------------- /htdp-test/tests/htdp-lang/test-htdp.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/load 2 | 3 | (load-relative (collection-file-path "loadtest.rktl" "tests/racket")) 4 | 5 | (define testing-path (collection-file-path "testing.rktl" "tests/racket")) 6 | 7 | (load-in-sandbox "beginner.rktl" #:testing testing-path) 8 | (load-in-sandbox "beginner-abbr.rktl" #:testing testing-path) 9 | (load-in-sandbox "intermediate.rktl" #:testing testing-path) 10 | (load-in-sandbox "intermediate-lambda.rktl" #:testing testing-path) 11 | (load-in-sandbox "advanced.rktl" #:testing testing-path) 12 | 13 | (report-errs #t) 14 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/already-defined.rktl: -------------------------------------------------------------------------------- 1 | (define first 3) 2 | 3 3 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/annotation.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require stepper/private/annotate 4 | "test-engine.rkt" 5 | "language-level-model.rkt" 6 | rackunit) 7 | 8 | ;; does annotation finish without an exception? 9 | 10 | ;; this is a pathetic "set" of tests, but I just spent time debugging 11 | ;; a problem that would have been caught by this test, so I'm adding 12 | ;; it anyway. More generally, it might be nice to take every test in 13 | ;; the through-tests suite and make sure that it can be annotated without 14 | ;; failure before trying to run it. 15 | 16 | (define (try-annotating str) 17 | (define expanded 18 | (car (string->expanded-syntax-list intermediate str))) 19 | ;(printf "expanded: ~s\n" expanded) 20 | (annotate expanded (lambda (a b c) 'bogus) #f)) 21 | 22 | (define (try-annotating/hashlang str) 23 | (define expanded 24 | (car (string->expanded-syntax-list intermediate/h str))) 25 | ;(printf "expanded: ~s\n" expanded) 26 | (annotate expanded (lambda (a b c) 'bogus) #f)) 27 | 28 | (module+ test 29 | (check-not-exn (lambda () (try-annotating "(check-expect 2 2)"))) 30 | 31 | (check-not-exn 32 | (lambda () 33 | (try-annotating/hashlang " 34 | (/ 3 0) 35 | (+ 9 123)")))) -------------------------------------------------------------------------------- /htdp-test/tests/stepper/bad-letrec-test.rktl: -------------------------------------------------------------------------------- 1 | (letrec ([a a]) 3) 2 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/big-bang-test.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-intermediate-reader.ss" "lang")((modname big-bang-test) (read-case-sensitive #t) (teachpacks ((lib "universe.ss" "teachpack" "2htdp") (lib "image.ss" "teachpack" "2htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "universe.ss" "teachpack" "2htdp") (lib "image.ss" "teachpack" "2htdp"))))) 4 | (define (draw-world x) (rectangle 100 (round (* x 0.1)) "solid" "red")) 5 | 6 | (draw-world 500) 7 | 8 | (big-bang 0 9 | [on-tick add1] 10 | [to-draw draw-world 500 500]) 11 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/constructor-redexes.rktl: -------------------------------------------------------------------------------- 1 | (cons 3 (cons 1 empty)) 2 | 3 | (cons 1 2) 4 | 5 | (list 1 2 3) 6 | 7 | (define-struct a (b)) 8 | 9 | (make-a 3) 10 | 11 | (make-a 4 3 5) 12 | 13 | (make-b 32) 14 | 15 | (make-b 3 4 5) 16 | 17 | (define-struct b (c d e)) 18 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/find-tag-test.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require stepper/private/find-tag 3 | racket/gui/base 4 | rackunit 5 | racket/class) 6 | 7 | (define (mk-txt str) 8 | (define t (new text%)) 9 | (send t insert str) 10 | t) 11 | 12 | (define (find-tag/end str) 13 | (find-tag (mk-txt str) (string-length str))) 14 | 15 | (check-equal? (find-tag/end "") "a") 16 | (check-equal? (find-tag/end "") "abcdef") 17 | (check-equal? (find-tag/end "") "abcdef") 18 | (check-equal? (find-tag/end "") "abcdef") 19 | (check-equal? (find-tag/end "") "b") 20 | (check-equal? (find-tag/end "") "b") 21 | 22 | (check-equal? (find-tag/end "") #f) 23 | 24 | (check-equal? (find-tag/end "") #f) 25 | (check-equal? (find-tag/end "") #f) 26 | (check-equal? (find-tag/end "") #f) 27 | (check-equal? (find-tag/end "") #f) 28 | 29 | (check-equal? (find-tag/end "<>") #f) 30 | 31 | ;; would be nice to make these two tests work, but 32 | ;; it isn't clear what the right predicate is when 33 | ;; searching backwards to get thse right but 34 | ;; not also get this one wrong: 35 | ;; " 36 | ; (check-equal? (find-tag/end "") #f) 37 | ; (check-equal? (find-tag/end "") #f) 38 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/global-prim-reduction.rktl: -------------------------------------------------------------------------------- 1 | #t 2 | 3 | true 4 | 5 | #f 6 | 7 | false 8 | 9 | null 10 | 11 | empty 12 | 13 | pi 14 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define test-omit-paths '("jump-to-ui-test.rkt" 4 | "big-bang-test.rkt")) 5 | 6 | (define test-responsibles '((all clements))) 7 | (define test-timeouts '(("run-manual-tests.rkt" 500) 8 | ("automatic-tests.rkt" 800))) 9 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/intermediate-y.rktl: -------------------------------------------------------------------------------- 1 | (let ((Y (lambda (f) 2 | (let ((g (lambda (x) 3 | (apply f (list (lambda (z1 z2) 4 | (apply (apply x (list x)) (list z1 z2)))))))) 5 | (g g)))) 6 | (newappend (lambda (ap) 7 | (lambda (x y) 8 | (if (null? x) 9 | y 10 | (cons (first x) 11 | (apply ap (list (rest x) y))))))) 12 | (l (cons 1 (cons 2 (cons 3 null))))) 13 | (apply (Y newappend) (list l l))) 14 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/jump-to-ui-test.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrScheme. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-intermediate-reader.ss" "lang")((modname jump-to-ui-test) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) 4 | (+ 3 4) 5 | 6 | (+ 4 5) 7 | 8 | (check-expect (+ 5 6) 11) 9 | 10 | (+ 6 7) 11 | 12 | (+ 7 8) 13 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/lambda-test.rktl: -------------------------------------------------------------------------------- 1 | (define ident (lambda (x) (+ (- x 1) 1))) 2 | 3 | (ident 14) 4 | 5 | (ident 3) 6 | 7 | (define (ident-2 x) (+ (- x 1) 1)) 8 | 9 | (ident-2 14) 10 | 11 | (ident-2 3) 12 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/let-test.rktl: -------------------------------------------------------------------------------- 1 | (define a 15) 2 | 3 | ; basic testing 4 | 5 | (define (test x) 6 | (let ([a (+ a 3)] 7 | [b (- a 39)]) 8 | (+ a b))) 9 | 10 | (test 1) 11 | (test 2) 12 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/letrec-test.rktl: -------------------------------------------------------------------------------- 1 | (define a 15) 2 | 3 | (define (test c) 4 | (letrec ([a (+ c 13)] 5 | [b (+ a 90)]) 6 | (+ a b))) 7 | 8 | (test 13) 9 | (test 14) 10 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/local-define-struct.rktl: -------------------------------------------------------------------------------- 1 | (define (gen ignored) 2 | (local ((define-struct local-struct (local-field)) 3 | (define silly-def (+ 3 4))) 4 | (make-local-struct 13))) 5 | 6 | (define p (gen 1)) 7 | (define q (gen 1)) 8 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/local-test-2.rktl: -------------------------------------------------------------------------------- 1 | (define (create-closure x) 2 | (local ((define a 13) 3 | (define (closure y) 4 | (+ a x y))) 5 | closure)) 6 | 7 | (define closure-1 (create-closure 1)) 8 | (define closure-2 (create-closure 2)) 9 | 10 | (closure-1 100) 11 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/local-test.rktl: -------------------------------------------------------------------------------- 1 | (+ 14 2 | (local 3 | ((define (fact x) 4 | (if (= x 0) 5 | 1 6 | (* x (fact (- x 1))))) 7 | (define nother (lambda (x) x)) 8 | (define a (+ 3 5)) 9 | (define b (+ a 13))) 10 | (fact b))) 11 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/long-error-message.rktl: -------------------------------------------------------------------------------- 1 | (add1 3 (list 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)) 2 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/manual-tests.txt: -------------------------------------------------------------------------------- 1 | - open stepper, make sure it works for (+ 3 4). 2 | 3 | - make sure that stepper button appears and disappears as necessary when 4 | language level changes. 5 | 6 | - make sure that the stepper works for the #lang htdp/bsl style of language 7 | specification. 8 | 9 | - Make sure that you get a warning when you change the underlying program, and a 10 | warning when the program window disappears. 11 | 12 | - Try stepping backward and forward through programs with correct and erroneous 13 | (syntax errors, runtime errors) executions, incl. jumping to end. 14 | 15 | Here's one to try: 16 | 17 | (define (f x) 18 | (if (empty? x) 19 | (cons 13 '()) 20 | (cons 4 (f (rest x))))) 21 | 22 | (f (list 7 7 7 7)) 23 | 24 | - For a syntax error, delete a close paren. 25 | 26 | - For a runtime error, change (cons 13 '()) into 13 27 | 28 | - Try programs which print snips (print-convert-test.ss) 29 | 30 | - Try programs that contain test cases; make sure that the popups behave sensibly. 31 | 32 | e.g. 33 | 34 | 35 | (check-expect (f (list 4)) 36 | (list 4 13)) 37 | (check-expect (f (list 4)) 38 | (list 7 13)) 39 | 40 | - try big-bang program. 41 | 42 | - try SdP program, make sure that test cases don't show extra steps. 43 | 44 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/multiply-defined.rktl: -------------------------------------------------------------------------------- 1 | (define d 3) 2 | 3 | (define (d x) 3) 4 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/name-chaining.rktl: -------------------------------------------------------------------------------- 1 | (define (add-1 x) (+ 1 x)) 2 | 3 | (define g add-1) 4 | 5 | g 6 | 7 | (define h g) 8 | 9 | (h 4) 10 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/no-else-clause.rktl: -------------------------------------------------------------------------------- 1 | (cond [#f 3] 2 | [(= 3 4) 4]) 3 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/non-procedure.rktl: -------------------------------------------------------------------------------- 1 | (define my-var 15) 2 | 3 | (my-var 3) 4 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/printing-reducing-test.rktl: -------------------------------------------------------------------------------- 1 | (first (cons 1 empty)) 2 | 3 | (vector 1 2 3) 4 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/procedure-display.rktl: -------------------------------------------------------------------------------- 1 | (define a (lambda (b c) (+ b c))) 2 | 3 | (define (b c) (+ c 5)) 4 | 5 | (+ (a 3 5) (b 9)) 6 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/recur-test: -------------------------------------------------------------------------------- 1 | (define (my-proc x) 2 | (+ (my-proc (- x 1)) x)) 3 | 4 | (my-proc 34) 5 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/right-redex.rktl: -------------------------------------------------------------------------------- 1 | (+ #t (if #t #t #t) #t) 2 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/run-manual-tests.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | 4 | (require "through-tests.rkt" 5 | #;(prefix-in m: "language-level-model.rkt") 6 | "test-engine.rkt") 7 | 8 | ;; this file is for manual checking of individual normally-automated tests. 9 | 10 | ;; omit from testing 11 | (module* test racket/base) 12 | 13 | (module+ main 14 | (printf "ready to run tests.\n") 15 | 16 | ;; NB: unlike standard linux config-file convention, the values 17 | ;; associated with the commented-out parameters are *not* the 18 | ;; default ones, but rather the ones you're likely to want 19 | ;; to use instead of the default. 20 | (parameterize (#;[disable-stepper-error-handling #t] 21 | #;[display-only-errors #t] 22 | #;[show-all-steps #t] 23 | #;[ignore-non-lang-tests? #t]) 24 | (run-tests '(ellipses-used-parens-2)) 25 | #;(run-all-tests) 26 | 27 | 28 | #;(syntax-case 29 | (first (string->expanded-syntax-list m:intermediate 30 | "(if true 3 4)" 31 | #;"(letrec ([z 19] [a (lambda (x) (a x))] [b 4]) (+ (a 4) b))")) 32 | () 33 | [(_ _ _ 34 | (_ _ (_ _ (_ _ it) _))) #'it]) 35 | )) -------------------------------------------------------------------------------- /htdp-test/tests/stepper/structures.rktl: -------------------------------------------------------------------------------- 1 | (define-struct item (name price)) 2 | 3 | (define inventory (cons (make-item 'rabbit 32.42) 4 | (cons (make-item 'twiggy 3.18) 5 | (cons (make-item 'richard-nixon 0.45) 6 | empty)))) 7 | 8 | (+ 3 4) 9 | 10 | (define (sum-up-prices item-list) 11 | (cond ([null? item-list] 0) 12 | (else (+ (item-price (car item-list)) 13 | (sum-up-prices (cdr item-list)))))) 14 | 15 | (sum-up-prices inventory) 16 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/symbol-identifier.rktl: -------------------------------------------------------------------------------- 1 | (define (appy x) (list x 'x)) 2 | 3 | (define foo (appy 'putz)) 4 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/symbols.rktl: -------------------------------------------------------------------------------- 1 | (+ 3 4) 2 | 3 | (define f 'foo) 4 | 5 | (define g f) 6 | 7 | (+ 3 4) 8 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/syntax-error-ordering.rktl: -------------------------------------------------------------------------------- 1 | (lambda) 2 | 3 | ( 4 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/test-or.rktl: -------------------------------------------------------------------------------- 1 | (define a 3) 2 | 3 | (or #f a #t) 4 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/two-tests.rktl: -------------------------------------------------------------------------------- 1 | (define (mult a b) (* a b)) 2 | (define g (if #f mult +)) 3 | (define (f a b) (g 3 4)) 4 | (f 5 6) 5 | 6 | ;(define (f x) x) 7 | ;(define g +) 8 | ;g 9 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/unannotated.rktl: -------------------------------------------------------------------------------- 1 | (define (squar x) (* x x)) 2 | 3 | (define (square-all list-of-numbers) 4 | (map squar list-of-numbers)) 5 | 6 | (define (my-map a-list) 7 | (cond [(empty? a-list) empty] 8 | [else (cons (square-all (car a-list)) 9 | (my-map (cdr a-list)))])) 10 | 11 | (my-map (cons (cons 1 (cons 3 (cons 14 empty))) 12 | (cons (cons 3 (cons 4 empty)) 13 | (cons (cons 43 empty) 14 | empty)))) 15 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/undefined.rktl: -------------------------------------------------------------------------------- 1 | x 2 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/world-test.rktl: -------------------------------------------------------------------------------- 1 | (define (next t) 2 | (+ t 1)) 3 | 4 | (define (image t) 5 | (place-image (circle 3 'solid 'red) 20 t (empty-scene 50 50))) 6 | 7 | ;; --- run program run 8 | (big-bang 50 50 .1 0) 9 | (on-redraw image) 10 | (on-tick-event next) 11 | -------------------------------------------------------------------------------- /htdp-test/tests/stepper/write-display.rktl: -------------------------------------------------------------------------------- 1 | (define (f x) "some string") 2 | 3 | (f 3) 4 | -------------------------------------------------------------------------------- /htdp-test/tests/test-engine/at-top-level.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (module m lang/htdp-beginner (check-expect 1 1)) 3 | ;; this file tests that a `check-expect` all on its lonesome 4 | ;; in the top-level of a module is not a syntax error 5 | -------------------------------------------------------------------------------- /htdp-test/tests/test-engine/check-error-message.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require rackunit) 4 | 5 | ;; this test case grabs all the output 6 | ;; just to check that the right kind of 7 | ;; error is printed out (the bug this 8 | ;; test case was in response to was 9 | ;; a bad error message from the check-satsified 10 | ;; implementation) 11 | 12 | (define (tester e) 13 | (let ([sp (open-output-string)]) 14 | (string-append 15 | (with-handlers ([exn:fail? exn-message]) 16 | (parameterize ([current-output-port sp]) 17 | (eval `(module a racket (require test-engine/racket-tests) ,e (test)) 18 | (make-base-namespace)) 19 | "no failure")) 20 | (get-output-string sp)))) 21 | 22 | 23 | (check-regexp-match 24 | #rx"check-error: expects at least 1 argument, but found none" 25 | (tester '(check-error))) 26 | 27 | (check-regexp-match 28 | #rx"check-error: expects only 2 arguments, but found 3" 29 | (tester '(check-error (error "hello") 2 3))) 30 | 31 | -------------------------------------------------------------------------------- /htdp-test/tests/test-engine/check-expect.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require (for-syntax racket/base) 3 | rackunit) 4 | 5 | (define-syntax (run stx) 6 | (syntax-case stx () 7 | [(build name exp ...) 8 | (let ([modname (string->symbol (format "mod~a" (syntax-line stx)))]) 9 | (datum->syntax 10 | stx 11 | `(begin 12 | (module ,modname racket/base 13 | (require test-engine/racket-tests) 14 | (provide get-output) 15 | ,@(syntax->list #'(exp ...)) 16 | (define sp (open-output-string)) 17 | (parameterize ([current-output-port sp]) 18 | (test)) 19 | (define (get-output) (get-output-string sp))) 20 | (require (submod "." ,modname)) 21 | (define ,#'name (get-output)))))])) 22 | 23 | (run ch1 (check-expect "hello" "world")) 24 | (check-regexp-match #rx"Actual value.*\"hello\"" ch1) 25 | (check-regexp-match #rx"(\"world\".*expected value)|(Expected value.\"world\")" ch1) 26 | 27 | -------------------------------------------------------------------------------- /htdp-test/tests/test-engine/check-failed-bsl.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname check-failed-bsl) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | 5 | ;; MUST BE IN BSL 6 | ;; expect the two errors to be reported as four failed tests 7 | ;; this is about plural/singular 8 | 9 | ;; f: expects only 1 argument, but found 2 10 | ;; f: expects 1 argument, but found none 11 | ;; g: expects only 2 arguments, but found 3 12 | 13 | (define (f x) x) 14 | (check-expect (f 1 2) 3) 15 | (check-expect (f) 1) 16 | (check-satisfied (f 1 2) odd?) 17 | (define (g x y) x) 18 | (check-expect (g 1 2 3) 4) 19 | -------------------------------------------------------------------------------- /htdp-test/tests/test-engine/check-failed-isl.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-intermediate-reader.ss" "lang")((modname check-failed-isl) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | 5 | ;; MUST BE IN ISL 6 | ;; expect the two errors to be reported as two failed tests 7 | ;; f: expects only 1 argument, but found 2 8 | 9 | (define (f x) x) 10 | (check-expect (f 1 2) 3) 11 | (check-satisfied (f 1 2) odd?) -------------------------------------------------------------------------------- /htdp-test/tests/test-engine/check-ordered.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname check-ordered) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | ; #lang htdp/bsl 5 | 6 | ;; BUT THE RENDERING OF THE OUTPUT SUCKS. IT SEEMS TO LACK A NEWLINE. 7 | 8 | (check-expect (g 30) "goodbye") 9 | (f 40) 10 | (define (f x) "hello") 11 | (define (g y) "goodbye") 12 | -------------------------------------------------------------------------------- /htdp-test/tests/test-engine/check-satisfied.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (require test-engine/racket-tests 3 | (except-in rackunit check-within)) 4 | 5 | ;; this test case grabs all the output 6 | ;; just to check that the right kind of 7 | ;; error is printed out (the bug this 8 | ;; test case was in response to was 9 | ;; a bad error message from the check-satsified 10 | ;; implementation) 11 | (check-regexp-match 12 | #rx"check-satisfied.*encountered an error" 13 | (let ([sp (open-output-string)]) 14 | (string-append 15 | (with-handlers ([exn:fail? exn-message]) 16 | (parameterize ([current-output-port sp]) 17 | (define (f x) x) 18 | (define (q? x) x) 19 | (check-satisfied (f 1 2) q?) 20 | (test) 21 | "no failure")) 22 | (get-output-string sp)))) 23 | 24 | (check-regexp-match 25 | #rx"no failure" 26 | (let ([sp (open-output-string)]) 27 | (string-append 28 | (with-handlers ([exn:fail? exn-message]) 29 | (parameterize ([current-output-port sp]) 30 | (define (f x) x) 31 | (define (q? x) x) 32 | (check-satisfied (f 1 2) q?) 33 | (test) 34 | "no failure")) 35 | (get-output-string sp)))) 36 | 37 | -------------------------------------------------------------------------------- /htdp-test/tests/test-engine/check-satisfied1.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname check-satisfied1) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | ;; ASSUME: THIS FILE is IN BSL 5 | 6 | (define (id x) x) 7 | 8 | (check-satisfied 9 (id odd?)) 9 | ;; expected syntax error, can also trigger this with check-syntax 10 | "odd?: expected a function call, but there is no open parenthesis before this function" 11 | -------------------------------------------------------------------------------- /htdp-test/tests/test-engine/check-satisfied2.rkt: -------------------------------------------------------------------------------- 1 | #lang htdp/bsl 2 | 3 | ;; ASSUME: THIS FILE is IN BSL 4 | 5 | (check-satisfied (random 10) 11) 6 | ;; raise run-time error w/o poping up report window but show string below first 7 | 8 | "check-satisfied: expects function of one argument in second position. Given 11" 9 | -------------------------------------------------------------------------------- /htdp-test/tests/test-engine/check-satisfied3.rkt: -------------------------------------------------------------------------------- 1 | #lang htdp/bsl 2 | 3 | ;; ASSUME: THIS FILE is IN BSL 4 | 5 | ;; the following just fail, pop up window and show 6 | 7 | (check-satisfied 4 odd?) 8 | (check-satisfied (+ (random 2) 1) zero?) 9 | 10 | -------------------------------------------------------------------------------- /htdp-test/tests/test-engine/check-satisfied4.rkt: -------------------------------------------------------------------------------- 1 | #lang htdp/bsl 2 | 3 | ;; ASSUME: THIS FILE is IN BSL 4 | 5 | (check-satisfied 3 equal?) 6 | "check-satisfied: expects function of one argument in second position. Given equal?" 7 | -------------------------------------------------------------------------------- /htdp-test/tests/test-engine/check-satisfied5.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-intermediate-reader.ss" "lang")((modname check-satisfied5) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) 4 | ;; ASSUME: THIS FILE is IN ISL 5 | 6 | (define (id x) x) 7 | (check-satisfied 3 (id equal?)) 8 | ;; just error, w/o showing the report window but show string below 9 | "check-satisfied: expects function of one argument in second position. Given equal?" 10 | -------------------------------------------------------------------------------- /htdp-test/tests/test-engine/check-satisfied6.rkt: -------------------------------------------------------------------------------- 1 | #lang htdp/bsl 2 | 3 | ;; ASSUME: THIS FILE is IN BSL 4 | 5 | ;; all these tests just work out fine 6 | ;; ---------------------------------- 7 | 8 | (check-satisfied 4 even?) 9 | 10 | (define (okay? x) (member? x (list 0 1 2 3 4 5 6 7 8 9))) 11 | (check-satisfied (random 10) okay?) 12 | 13 | ;; runs fine, even if the predicate is defined below the check-satisfied test 14 | 15 | (check-satisfied (random 10) between-0-and-10?) 16 | (define (between-0-and-10? x) (member? x (list 0 1 2 3 4 5 6 7 8 9))) 17 | 18 | 19 | -------------------------------------------------------------------------------- /htdp-test/tests/test-engine/check-satisfied7.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname check-satisfied7) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ()))) 4 | ;; ASSUME: THIS FILE is IN ISL+ 5 | 6 | ;; all these tests just work out fine 7 | ;; ---------------------------------- 8 | 9 | (define (id x) x) 10 | 11 | (check-satisfied 4 (id even?)) 12 | 13 | (define (okay? x) (member? x (list 0 1 2 3 4 5 6 7 8 9))) 14 | (check-satisfied (random 10) (id okay?)) 15 | 16 | ;; runs fine, even if the predicate is defined below the check-satisfied test 17 | 18 | (check-satisfied (random 10) (id between-0-and-10?)) 19 | (define (between-0-and-10? x) (member? x (list 0 1 2 3 4 5 6 7 8 9))) 20 | 21 | 22 | (define (ho x) 23 | (lambda (y) 24 | (equal? x y))) 25 | 26 | (check-satisfied 10 (ho 10)) -------------------------------------------------------------------------------- /htdp-test/tests/test-engine/check-satisfied8.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname check-satisfied8) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | ;; raise run-time error that blames expt 5 | 6 | (define (arity-problem-inside n) 7 | (> (expt 2 n 0))) 8 | 9 | (check-satisfied 2 arity-problem-inside) -------------------------------------------------------------------------------- /htdp-test/tests/test-engine/check-satisfied9.rkt: -------------------------------------------------------------------------------- 1 | ;; The first three lines of this file were inserted by DrRacket. They record metadata 2 | ;; about the language level of this file in a form that our tools can easily process. 3 | #reader(lib "htdp-beginner-reader.ss" "lang")((modname check-satisfied9) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f))) 4 | 5 | ;; ensure that errors report failure of 'predicateness' properly 6 | 7 | (define (f x) x) 8 | "f [as predicate in check-satisfied]: is expected to return a boolean, but it returned 0" 9 | (check-satisfied 0 f) 10 | -------------------------------------------------------------------------------- /htdp-test/tests/test-engine/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define test-responsibles '((all (matthias sperber)))) 4 | 5 | (define test-omit-paths '("check-satisfied1.rkt" 6 | "check-satisfied2.rkt" 7 | "check-satisfied3.rkt" 8 | "check-satisfied4.rkt" 9 | "check-satisfied5.rkt" 10 | "check-satisfied8.rkt" 11 | "check-satisfied9.rkt" 12 | "check-failed-bsl.rkt" 13 | "check-failed-isl.rkt" 14 | "check-ordered.rkt")) 15 | 16 | (define compile-omit-paths '("check-satisfied1.rkt")) 17 | -------------------------------------------------------------------------------- /htdp-test/tests/test-engine/signature-asl.rkt: -------------------------------------------------------------------------------- 1 | #lang htdp/asl 2 | (require test-engine/test-engine) 3 | (require rackunit) 4 | 5 | (define (assert-signature-violation got) 6 | (begin 7 | (let ((violations 8 | (test-object-signature-violations 9 | (current-test-object)))) 10 | (begin 11 | (check-equal? (length violations) 1) 12 | (let* ((violation (car violations)) 13 | (message (signature-violation-message violation))) 14 | (begin 15 | (check-pred signature-got? message) 16 | (check-equal? (signature-got-value message) 17 | got))))) 18 | (initialize-test-object!))) 19 | 20 | (: a Integer) 21 | (define a "foo") 22 | 23 | (assert-signature-violation "foo") 24 | -------------------------------------------------------------------------------- /htdp/LICENSE: -------------------------------------------------------------------------------- 1 | This component of Racket is distributed under the Apache 2.0 and MIT 2 | licenses. The user can choose the license under which they will be 3 | using the software. There may be other licenses within the 4 | distribution with which the user must also comply. 5 | 6 | See the files 7 | https://github.com/racket/racket/blob/master/racket/src/LICENSE-APACHE.txt 8 | and 9 | https://github.com/racket/racket/blob/master/racket/src/LICENSE-MIT.txt 10 | for the full text of the licenses. 11 | -------------------------------------------------------------------------------- /htdp/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection 'multi) 4 | 5 | (define deps '("htdp-lib" "htdp-doc")) 6 | (define implies '("htdp-lib" "htdp-doc")) 7 | 8 | (define pkg-desc "Teaching languages for _How to Design Programs_") 9 | 10 | (define pkg-authors '(matthias mflatt robby)) 11 | 12 | (define license 13 | '(Apache-2.0 OR MIT)) 14 | --------------------------------------------------------------------------------