From 9d23e66fe8332abc7a1bbd9022f3e58e1133b3fb Mon Sep 17 00:00:00 2001 From: rsiddharth Date: Fri, 3 Jul 2020 15:49:09 -0400 Subject: name directories like the realm repo. --- five/guess.rkt | 75 ---------------- five/loco.rkt | 59 ------------- five/resources/caroille.png | Bin 886 -> 0 bytes five/resources/caroille.svg | 125 --------------------------- five/resources/ufo-fart.png | Bin 868 -> 0 bytes five/resources/ufo-fart.svg | 188 ----------------------------------------- five/resources/zarking-ufo.png | Bin 1337 -> 0 bytes five/resources/zarking-ufo.svg | 128 ---------------------------- five/ufo.rkt | 86 ------------------- 9 files changed, 661 deletions(-) delete mode 100644 five/guess.rkt delete mode 100644 five/loco.rkt delete mode 100644 five/resources/caroille.png delete mode 100644 five/resources/caroille.svg delete mode 100644 five/resources/ufo-fart.png delete mode 100644 five/resources/ufo-fart.svg delete mode 100644 five/resources/zarking-ufo.png delete mode 100644 five/resources/zarking-ufo.svg delete mode 100644 five/ufo.rkt (limited to 'five') diff --git a/five/guess.rkt b/five/guess.rkt deleted file mode 100644 index f7a117a..0000000 --- a/five/guess.rkt +++ /dev/null @@ -1,75 +0,0 @@ -#lang racket -(require 2htdp/universe 2htdp/image) - -(struct interval (small big guesses)) - -;;; constants -(define TEXT-SIZE 12) -(define HELP-TEXT - (text "↑ for larger numbers, ↓ for smaller ones" - TEXT-SIZE - "blue")) -(define HELP-TEXT2 - (text "Press = when your number is guessed; q to quit." - TEXT-SIZE - "blue")) -(define COLOR "red") -(define WIDTH (+ (image-width HELP-TEXT2) 10)) -(define HEIGHT 150) -(define SIZE 72) -(define TEXT-X 3) -(define TEXT-UPPER-Y 10) -(define TEXT-LOWER-Y 135) -(define GUESSES-SIZE 12) -(define GUESSES-COLOR "green") -(define MT-SC - (place-image/align - HELP-TEXT TEXT-X TEXT-UPPER-Y "left" "top" - (place-image/align - HELP-TEXT2 TEXT-X TEXT-LOWER-Y "left" "bottom" - (empty-scene WIDTH HEIGHT)))) - -;; main -(define (start lower upper) - (big-bang (interval lower upper 0) - (on-key deal-with-guess) - (to-draw render) - (stop-when single? render-last-scene))) - -;; key events -(define (deal-with-guess w key) - (cond [(key=? key "up") (bigger w)] - [(key=? key "down") (smaller w)] - [(key=? key "q") (stop-with w)] - [(key=? key "=") (stop-with w)] - [else w])) - -(define (smaller w) - (interval (interval-small w) - (max (interval-small w) (sub1 (guess w))) - (+ 1 (interval-guesses w)))) - -(define (bigger w) - (interval (min (interval-big w) (add1 (guess w))) - (interval-big w) - (+ 1 (interval-guesses w)))) - -(define (guess w) - (quotient (+ (interval-small w) (interval-big w)) 2)) - -(define (render w) - (overlay (overlay/offset - (text (number->string (guess w)) SIZE COLOR) 0 40 - (text (number->string (interval-guesses w)) - GUESSES-SIZE GUESSES-COLOR)) - MT-SC)) - -(define (render-last-scene w) - (overlay (overlay/offset - (text "End" SIZE COLOR) 0 40 - (text (number->string (interval-guesses w)) - GUESSES-SIZE GUESSES-COLOR)) - MT-SC)) - -(define (single? w) - (= (interval-small w) (interval-big w))) diff --git a/five/loco.rkt b/five/loco.rkt deleted file mode 100644 index 977c976..0000000 --- a/five/loco.rkt +++ /dev/null @@ -1,59 +0,0 @@ -#lang racket -(require 2htdp/universe 2htdp/image) - -(define WIDTH 300) -(define HEIGHT 300) -(define CAROILLE (bitmap/file "resources/caroille.png")) -(define CAROILLE-WIDTH (image-width CAROILLE)) - -;;; -;;; If the car is placed at X = 1/2 its width, its back will be -;;; touching the left edge of the World. -;;; -;;; If the car is place at X = - 1/2 its width, its front will be touching -;;; the left edge of the World. -;;; -(define CAROILLE-WIDTH-HALF (/ CAROILLE-WIDTH 2.0)) - -;;; Structure to represent the X position of two cars in animation. -(struct cars (one two)) - -(define (caroille-past-right-edge? pos) - (> pos (- WIDTH CAROILLE-WIDTH-HALF))) - -(define (caroille-fully-past-right-edge? pos) - (>= pos (+ WIDTH CAROILLE-WIDTH-HALF))) - -(define (caroille-fully-past-left-edge? pos) - (>= pos CAROILLE-WIDTH-HALF)) - -(define (caroille-fully-inside? pos) - (and (caroille-fully-past-left-edge? pos) - (not (caroille-past-right-edge? pos)))) - -(define (move caroilles) - (let ((caroille-one (cars-one caroilles)) - (caroille-two (cars-two caroilles))) - (cond - ;; Case set I - one of the cars is fully inside. - ((caroille-fully-inside? caroille-one) - (cars (+ 1 caroille-one) caroille-two)) - ((caroille-fully-inside? caroille-two) - (cars caroille-one (+ 1 caroille-two))) - ;; Case set II - one of the cars disappeared into the right edge. - ((caroille-fully-past-right-edge? caroille-one) - (cars (- CAROILLE-WIDTH-HALF) (+ 1 caroille-two))) - ((caroille-fully-past-right-edge? caroille-two) - (cars (+ 1 caroille-one) (- CAROILLE-WIDTH-HALF))) - ;; Case else - Both cars are partially out. - (else (cars (+ 1 caroille-one) (+ 1 caroille-two)))))) - -(define (draw-cars caroilles) - (place-image CAROILLE (cars-one caroilles) (/ HEIGHT 2) - (place-image CAROILLE (cars-two caroilles) (/ HEIGHT 2) - (empty-scene WIDTH HEIGHT)))) - -(define (start) - (big-bang (cars CAROILLE-WIDTH-HALF (- CAROILLE-WIDTH-HALF)) - (on-tick move) - (to-draw draw-cars))) diff --git a/five/resources/caroille.png b/five/resources/caroille.png deleted file mode 100644 index 052cc58..0000000 Binary files a/five/resources/caroille.png and /dev/null differ diff --git a/five/resources/caroille.svg b/five/resources/caroille.svg deleted file mode 100644 index eb4db63..0000000 --- a/five/resources/caroille.svg +++ /dev/null @@ -1,125 +0,0 @@ - - - - - caroille - - - - - - - - image/svg+xml - - caroille - - 2018-04-02 - - - rsiddharth <s@ricketyspace.net> - - - - - car - - - - - - - - - - - - - - - - - - - diff --git a/five/resources/ufo-fart.png b/five/resources/ufo-fart.png deleted file mode 100644 index 13d1c4a..0000000 Binary files a/five/resources/ufo-fart.png and /dev/null differ diff --git a/five/resources/ufo-fart.svg b/five/resources/ufo-fart.svg deleted file mode 100644 index cf86021..0000000 --- a/five/resources/ufo-fart.svg +++ /dev/null @@ -1,188 +0,0 @@ - - - - - UFO Fart - - - - - - image/svg+xml - - UFO Fart - - 2018-04-17 - - - rsiddharth <s@ricketyspace.net> - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/five/resources/zarking-ufo.png b/five/resources/zarking-ufo.png deleted file mode 100644 index bd5eb43..0000000 Binary files a/five/resources/zarking-ufo.png and /dev/null differ diff --git a/five/resources/zarking-ufo.svg b/five/resources/zarking-ufo.svg deleted file mode 100644 index 84b8844..0000000 --- a/five/resources/zarking-ufo.svg +++ /dev/null @@ -1,128 +0,0 @@ - - - - - Zarking UFO - - - - - - image/svg+xml - - Zarking UFO - - 2018-03-09 - - - rsiddharth <s@ricketyspace.net> - - - - - - - - - - - - - - - - - - - - diff --git a/five/ufo.rkt b/five/ufo.rkt deleted file mode 100644 index 6f8136c..0000000 --- a/five/ufo.rkt +++ /dev/null @@ -1,86 +0,0 @@ -#lang racket -(require 2htdp/universe 2htdp/image) - -;;; world structure -(struct ufo (x y fart)) - -;;; constants -(define WORLD-WIDTH 300) -(define WORLD-HEIGHT 325) -(define MOVE-LEN 3) -(define UFO (bitmap/file "resources/zarking-ufo.png")) -(define UFO-FART (bitmap/file "resources/ufo-fart.png")) -(define UFO-WIDTH (image-width UFO)) -(define UFO-HEIGHT (image-height UFO)) -(define UFO-FART-HEIGHT (image-height UFO-FART)) - -;;; ufo movement functions -(define (ufo-move-up current-state) - (let ((x (ufo-x current-state)) - (y-up (- (ufo-y current-state) MOVE-LEN)) - (fart #t)) - (cond [(>= y-up (+ (/ UFO-HEIGHT 2) (/ UFO-FART-HEIGHT 2))) - (ufo x y-up fart)] - [else current-state]))) - -(define (ufo-move-down current-state) - (let ((x (ufo-x current-state)) - (y-down (+ (ufo-y current-state) MOVE-LEN))) - (cond [(<= y-down (- (+ WORLD-HEIGHT (/ UFO-FART-HEIGHT 2)) - (/ UFO-HEIGHT 2))) - (ufo x y-down #t)] - [else current-state]))) - - -(define (ufo-move-left current-state) - (let ((x-left (- (ufo-x current-state) MOVE-LEN)) - (y (ufo-y current-state)) - (fart #t)) - (cond [(>= x-left (/ UFO-WIDTH 2)) - (ufo x-left y fart)] - [else current-state]))) - -(define (ufo-move-right current-state) - (let ((x-right (+ (ufo-x current-state) MOVE-LEN)) - (y (ufo-y current-state)) - (fart #t)) - (cond [(<= x-right (- WORLD-WIDTH (/ UFO-WIDTH 2))) - (ufo x-right y fart)] - [else current-state]))) - - -;;; big bang functions -(define (draw-a-ufo current-state) - (place-image (overlay/align/offset - "middle" "bottom" UFO 0 35 - (if (ufo-fart current-state) - UFO-FART - (circle 0 "outline" "white"))) - (ufo-x current-state) - (ufo-y current-state) - (empty-scene WORLD-WIDTH WORLD-HEIGHT))) - -(define (add-3-to-posy current-state) - (ufo (ufo-x current-state) - (+ (ufo-y current-state) 3))) - -(define (posy-is-300 current-state) - (>= (ufo-y current-state) 300)) - -(define (move-ufo current-state key) - (cond [(key=? key "up") (ufo-move-up current-state)] - [(key=? key "down") (ufo-move-down current-state)] - [(key=? key "left") (ufo-move-left current-state)] - [(key=? key "right") (ufo-move-right current-state)] - [else current-state])) - -(define (ufo-stopped current-state key) - (let ((fart #f)) - (ufo (ufo-x current-state) (ufo-y current-state) fart))) - -;;; the big bang -(big-bang (ufo (/ WORLD-WIDTH 2) (/ WORLD-HEIGHT 2) #f) - (to-draw draw-a-ufo) - (on-key move-ufo) - (on-release ufo-stopped)) - -- cgit v1.2.3