blob: 6f8136cc1367e05bf70347bb44f1de72cb994e7f (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
#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))
|
