diff --git a/collects/teachpack/2htdp/scribblings/nuworld.ss b/collects/teachpack/2htdp/scribblings/nuworld.ss deleted file mode 100644 index 56a536a350..0000000000 --- a/collects/teachpack/2htdp/scribblings/nuworld.ss +++ /dev/null @@ -1,119 +0,0 @@ -#lang slideshow - -(require slideshow/pict mred/mred) - -(define DELTA 80) -(define FT 12) - -(define txt - '("(big-bang World_0" - " (on-draw render WIDTH HEIGHT)" - " (on-tick tock RATE)" - " (on-mouse click)" - " (on-key react))" - )) - -(define program - (apply vl-append (map (lambda (t) (text t '() (- FT 2))) txt))) - -(define Program - (cc-superimpose - (rectangle (+ 5 (pict-width program)) (+ 5 (pict-height program))) - program)) - -(define (make-state txt) - (define t (text txt '() FT)) - (define e (rounded-rectangle (+ 10 (pict-width t)) (+ DELTA (pict-height t)))) - (cc-superimpose t e)) - -(define False (text "FALSE" '() FT)) -(define True (text "TRUE" '() FT)) -(define BOOL (rectangle (+ 5 (pict-width False)) (+ 5 (pict-height False)))) - -;; String Boolean -> Pict -(define (make-state0 txt b) - ;; create the basic state - (define t (text txt '() FT)) - (define s (if b - (cc-superimpose - (rounded-rectangle (+ 5 (pict-width t)) (+ (- DELTA 5) (pict-height t))) - t) - t)) - (define w - (cc-superimpose - s - (rounded-rectangle (+ 10 (pict-width t)) (+ DELTA (pict-height t))))) - ;; add the boolean - (define bb (cc-superimpose (if b True False) BOOL)) - (define ar (add-labeled-arrow (vc-append DELTA bb w) w ct-find bb cb-find "done")) - (define scene (text "Scene" '() FT)) - (define sc (cc-superimpose scene (rectangle (+ 20 (pict-width scene)) (+ 30 (pict-height scene))))) - (define br (add-labeled-arrow (vc-append DELTA ar sc) ar cb-find sc ct-find "render")) - br) - -(define (add-labeled-arrow nx locked lb-find closed lt-find txt) - (define-values (x0 y0) (lb-find nx locked)) - (define-values (x1 y1) (lt-find nx closed)) - (define lbl (text txt '() (- FT 2))) - (define wlbl (pict-width lbl)) - (define hlbl (pict-height lbl)) - (define x (- x0 (/ wlbl 2))) - (define y (+ y0 (/ ( - y1 y0 hlbl) 2))) - (pin-over (pin-arrow-line 4.0 nx locked lb-find closed lt-find) x y lbl)) - -(define (h-labeled-arrow t) - (define tock (text t '() (- FT 2))) - (define blk (blank (+ DELTA 4) 2)) - (vc-append tock (pin-arrow-line 4.0 blk blk lc-find blk rc-find))) - -(define arrows - (vc-append (h-labeled-arrow "tock") - (h-labeled-arrow "click") - (h-labeled-arrow "react"))) - -(define state0 (make-state0 "World_0" #f)) -(define state1 (make-state0 "World_1" #f)) -(define dots (cc-superimpose (blank (pict-width state1) (pict-height state1)) (text "..." '() FT))) -(define state2 (make-state0 "World_N-1" #f)) -(define stateN (make-state0 "World_N" #t)) -(define states (list state0 arrows state1 arrows dots arrows state2 arrows stateN)) - -(define bg (blank (+ (apply + (map pict-width states)) - DELTA #;(* (length states) DELTA)) - (+ (pict-height state0) DELTA))) - -(define (center base state x) - (define w (pict-height state)) - (define d (quotient (- width w) 2)) - (pin-over base x d state)) - -(define width (pict-height bg)) - -(define x (* 1/2 DELTA)) -(define xx - (foldl (lambda (f ls s) - (define y (center s f x)) - (set! x (+ x ls)) - y) - bg - states - (map (lambda (x) (+ (pict-width x) #;(* 1/1 DELTA))) states))) - -(define the-image (ct-superimpose xx Program)) - -(define image-bm - (make-object bitmap% - (inexact->exact (round (pict-width the-image))) - (inexact->exact (round (pict-height the-image))))) - -(send image-bm ok?) - -(define image-dc - (new bitmap-dc% [bitmap image-bm])) -(send image-dc clear) - -(draw-pict the-image image-dc 0.0 0.0) - -(send image-bm save-file "nuworld.png" 'png) - -the-image