Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

minor changes

  • Loading branch information...
commit b6e8588b847657534dffd6c833fbde7305cac5a2 1 parent dcaf390
Benjamin Lind authored
Showing with 61 additions and 49 deletions.
  1. +24 −4 init.rkt
  2. +12 −9 martingame.rkt
  3. +25 −36 martingui.rkt
View
28 init.rkt
@@ -28,6 +28,7 @@
(define player%
(class on-screen%
+ (inherit set-xy! get-sx)
(super-new)
(field (hp 2)) ; hitpoints
@@ -40,7 +41,7 @@
;---------------actions----------------------
(define/public (hit!) (if (> hp 0) (set! hp (- hp 1)) (display "Error already dead!")))
- (define/public (throw) (new snowball%))))
+ (define/public (throw) (begin (define snowball (new snowball%)) (send snowball set-xy! 0 0) snowball))))
@@ -52,7 +53,7 @@
;---------------set-methods-----------------
(define/public (set-throw_param! new-speed new-distance) (begin (set! speed new-speed)
- (set! distance new-distance)))
+ (set! distance new-distance)))
(define/public (set-power! power) (begin (set! speed power)
(set! distance (abs power)))) ; likely to be modifyed
@@ -64,7 +65,7 @@
;---------------actions---------------------
(define/public (move) ; Returns #t when maximum distance is reached
(begin (set-x! (+ (get-x) speed))
- (set! distance (- distance 1)) (= distance 0)))
+ (set! distance (- distance 1)) (= distance 0)))))
(define bunker%
@@ -90,4 +91,23 @@
(define *test-snow* (new snowball%))
-(define *test-bunker* (new bunker%))
+(define *test-bunker* (new bunker%))
+
+;----------instances-------------
+
+(define *player*
+ (new player%))
+
+
+;------------pictures-----------
+
+(define *image* (make-object bitmap% "testbild.jpg" 'unknown #f))
+(define *snowpic* (make-object bitmap% "snowball.jpg" 'unknown #f))
+(background 0 200 150)
+
+
+
+
+
+
+
View
21 martingame.rkt
@@ -1,5 +1,6 @@
(load "martingui.rkt")
-(require graphics/graphics)
+(load "init.rkt")
+;(require graphics/graphics) seems to work without it
(define Game%
(class object%
@@ -7,26 +8,29 @@
(field (WIDTH 21)
(HEIGHT 21)
(*should-run* #f)
- (image null))
+ (mouse-x 0)
+ (mouse-y 0)
+ )
(define/public (get-width) WIDTH)
(define/public (get-height) HEIGHT)
- (define (init)
- (set! image (make-object bitmap% "testbild.jpg" 'unknown #f))
- (background 0 100 0))
+
(define (draw)
(clear)
- (draw-pic image 0 0)
- ;(draw-pic gubbe gubbex gubbey) När vi har en gubbe med tillhörande koordinater ritas den ut
+ (draw-pic *image* mouse-x mouse-y);(draw-pic character characterx charactery). Draws a picture where the mouse is.
(show)
- ;(draw-text query-mouse-posn 200 200) query-mouse-posn ska nog inte användas
)
(define (update)
+ (send *player* set-xy! mouse-x mouse-y)
(draw))
+ (define/public (update-mouse x y)
+ (set! mouse-x x)
+ (set! mouse-y y))
+
(define/public (pause-update)
(set! *should-run* #f)
@@ -46,7 +50,6 @@
(show-gui *gui*)))
(define/public (start-game)
- (init)
(start-update)
)
)
View
61 martingui.rkt
@@ -34,15 +34,35 @@
(define my-canvas%
(class canvas%
(override on-char)
+ (override on-event)
(init-field (key-callback #f))
+ (init-field (mouse-callback #f))
(define (on-char event)
(when key-callback
(key-callback event)))
- (super-instantiate ())))
+ (define (on-event event)
+ (when mouse-callback
+ (mouse-callback event)))
+ (super-instantiate ())))
+
+
+(define (mouse-fn mouse-event)
+ (let ((x (send mouse-event get-x))
+ (y (send mouse-event get-y))
+ (type (send mouse-event get-event-type)))
+ (case type
+ ((leave) null)
+ ((left-down)
+ (send *player* throw))
+ ((right-down)
+ (background 0 0 0))
+ ((motion)
+ (send new-game update-mouse x y))
+ )))
+
+
+
-(define (key-fn key-event)
- (let ((key (send key-event get-key-code)))
- (send (get-field key-handler new-game) on-key key-event)))
(define (draw-canvas canvas dc)
(send dc draw-bitmap (get-buffer *gui*) 0 0))
@@ -124,33 +144,7 @@
(define *black-brush*
(send the-brush-list find-or-create-brush "black" 'solid))
-;; --------------------------------------------------------------------
-;; The animation loop
-;; --------------------------------------------------------------------
-;(define *should-run* #f)
-;
-;(define (start-loop)
-; (when (not *should-run*)
-; (set! *should-run* #t)
-; (thread loop)
-; (show-gui *gui*)))
-;
-;(define (stop-loop)
-; (set! *should-run* #f))
-;
-;(define (fps->seconds fps)
-; (/ 1 fps))
-;
-;(define *sleep-time* (fps->seconds 60))
-;
-;(define (loop)
-; (when *should-run*
-; (trandencent)
-; (update)
-; (draw)
-; (sleep *sleep-time*)
-; (loop)))
;; --------------------------------------------------------------------
;; The GUI and its components (buttons, menus etc)
@@ -158,11 +152,6 @@
(define *frame* (make-object frame% "Ben is awesome"))
-;(instantiate button%
-; ("Quit" *frame* (lambda (e b) (hide-gui *gui*)))
-; (horiz-margin 2)
-; (vert-margin 2)
-; (stretchable-width #f))
(define *menu-bar*
(instantiate menu-bar%
@@ -179,7 +168,7 @@
(instantiate my-canvas% ()
(parent *frame*)
(paint-callback draw-canvas)
- (key-callback key-fn)
+ (mouse-callback mouse-fn)
(min-height 672)
(min-width 672)
(stretchable-width #f)
Please sign in to comment.
Something went wrong with that request. Please try again.