Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

fatt hjalp av martin med visdom och kod. Nu fungerar uppdaterin och i…

…nlaggning av bilder utan att racket hanger sig.
  • Loading branch information...
commit dcaf3901c79cc4ff7f42ace127c22db8ee041a59 1 parent badd35a
Benjamin Lind authored
Showing with 326 additions and 7 deletions.
  1. +72 −7 canvas.rkt
  2. +56 −0 martingame.rkt
  3. +198 −0 martingui.rkt
79 canvas.rkt
View
@@ -2,17 +2,82 @@
-(define *frame* (make-object frame% "Spelplan"))
+;(define *frame* (make-object frame% "Spelplan")) *****Provar med koden under istället******
+
+;(define *canvas* (new game-canvas% [parent *frame*] ;;en canvas
+;[label "tjenare"]))
+
+(define game-canvas%
+ (class canvas%
+ (inherit get-width
+ get-height
+ refresh)
+ (init [keyboard-handler display]
+ [mouse-handler display])
+ (define on-key-handle keyboard-handler)
+ (define on-mouse-handle mouse-handler)
+ ;(define/override (on-char ke)
+ ;(on-key-handle ke))
+ ;(define/override (on-event me)
+ ;(on-mouse-handle me))
+ (super-new)))
+
+
+
+(define my-window (new frame% [label "Spelplan"]))
+(define my-canvas (new game-canvas%
+ ;[keyboard-handler keyboard-fn]
+ ;[mouse-handler mouse-fn]
+ [parent my-window]))
+;[paint-callback render-fn]))
+(define (render-fn canvas dc)
+
+ ;; Helpfn asks every object to render itself
+ (define (render-one obj)
+ (send obj render dc))
+ (for-each render-one *all-objects*))
+(send my-window show #t)
+
+
+
+
+(define agent%
+ (class object%
+ (init initial-x ...)
+ (define x initial-x)
+ ;...
+ (define/public (render dc)
+ (send dc translate x y)
+ (send dc rotate angle)
+ (send dc draw-bitmap img 0 0)
+ (send dc rotate (- angle))
+ (send dc translate (- x) (- y)))
+ ;...
+ (super-new)))
+
+(define (update)
+ (lambda () (begin
+ (send my-canvas refresh)
+ (draw-pic "testbild.jpg" 0 0))))
+
+(define my-timer ;rackets timer% kan sköta spelloopen
+ (new timer%
+ [interval 1000] ;16ms är ungefär 60FPS
+ [notify-callback update]
+ [just-once? #f]))
+
+
+
-(define *canvas* (new canvas% [parent *frame*] ;;en canvas
- [label "tjenare"]))
;; A procedures that draws a picture from file
(define (draw-pic file x y)
(send (send *canvas* get-dc) draw-bitmap (make-object bitmap% file 'unknown #f) x y))
-(send *frame* show #t)
-;; skriv detta för att lägga in en bild på koordinater
-;;(define (draw-pic file x y)
-;;(send (send *canvas* get-dc) draw-bitmap (make-object bitmap% file 'unknown #f) x y))
+
+;; lägger in en bild på koordinater x,y. Bilden bör ligga i samma mapp som canvas.rkt.
+(define (draw-pic file x y)
+ (send (send my-canvas get-dc) draw-bitmap (make-object bitmap% file 'unknown #f) x y))
+
+;; skriv t.ex (draw-pic "testbild.jpg" 10 20)
56 martingame.rkt
View
@@ -0,0 +1,56 @@
+(load "martingui.rkt")
+(require graphics/graphics)
+
+(define Game%
+ (class object%
+ (super-new)
+ (field (WIDTH 21)
+ (HEIGHT 21)
+ (*should-run* #f)
+ (image null))
+
+ (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
+ (show)
+ ;(draw-text query-mouse-posn 200 200) query-mouse-posn ska nog inte användas
+ )
+
+ (define (update)
+ (draw))
+
+
+ (define/public (pause-update)
+ (set! *should-run* #f)
+ )
+
+ (define/public (exit-game)
+ (pause-update)
+ (hide-gui *gui*))
+
+ (define/public (start-update)
+ (when (not *should-run*)
+ (set! *should-run* #t)
+ (new timer%
+ [notify-callback update]
+ [interval 20]
+ [just-once? #f])
+ (show-gui *gui*)))
+
+ (define/public (start-game)
+ (init)
+ (start-update)
+ )
+ )
+ )
+
+(define new-game (new Game%))
+(send new-game start-game)
198 martingui.rkt
View
@@ -0,0 +1,198 @@
+;; ---------------------------------------------------------------------
+;; GUI
+;; ---------------------------------------------------------------------
+
+;; CONSTRUCTOR
+
+(define (make-gui frame canvas buffer dc)
+ (list frame canvas buffer dc))
+
+;; SELECTORS
+
+(define (get-frame gui)
+ (car gui))
+
+(define (get-canvas gui)
+ (cadr gui))
+
+(define (get-buffer gui)
+ (caddr gui))
+
+(define (get-dc gui)
+ (cadddr gui))
+
+(define (show-gui gui)
+ (send (get-frame gui) show #t))
+
+(define (hide-gui gui)
+ (send (get-frame gui) show #f))
+
+;; ---------------------------------------------------------------------
+;; Canvas
+;; ---------------------------------------------------------------------
+
+(define my-canvas%
+ (class canvas%
+ (override on-char)
+ (init-field (key-callback #f))
+ (define (on-char event)
+ (when key-callback
+ (key-callback event)))
+ (super-instantiate ())))
+
+(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))
+
+(define (redraw)
+ (send (get-canvas *gui*) on-paint))
+
+;; ---------------------------------------------------------------------
+;; Functions to draw
+;; ---------------------------------------------------------------------
+
+; A procedure that clears the GUI
+(define (clear)
+ (send *dc* clear))
+
+; A procedure that sets the background color of the GUI
+(define (background)
+ (send *dc* set-background (make-object color% (random 255) (random 255) (random 255))))
+
+(define (background r g b)
+ (send *dc* set-background (make-object color% r g b)))
+
+;; A procedures that draws an ellipse
+(define (draw-circle x y size-x size-y pen brush)
+ (send (get-dc *gui*) set-pen pen)
+ (send (get-dc *gui*) set-brush brush)
+ (send (get-dc *gui*) draw-ellipse x y size-x size-y))
+
+;; A procedures that draws a rectangle
+(define (draw-rectangle x y size-x size-y pen brush)
+ (send (get-dc *gui*) set-pen pen)
+ (send (get-dc *gui*) set-brush brush)
+ (send (get-dc *gui*) draw-rectangle x y size-x size-y))
+
+;; A procedures that draws a line
+(define (draw-line x y size-x size-y pen brush)
+ (send (get-dc *gui*) set-pen pen)
+ (send (get-dc *gui*) set-brush brush)
+ (send (get-dc *gui*) draw-line x y (+ x size-x) (+ y size-y)))
+
+;; A procedures that draws text
+(define (draw-text text x y pen brush)
+ (send (get-dc *gui*) set-pen pen)
+ (send (get-dc *gui*) set-brush brush)
+ (send (get-dc *gui*) draw-text text x y))
+
+;; A procedures that draws a picture from file
+(define (draw-pic file x y)
+ (send (get-dc *gui*) draw-bitmap file x y))
+
+; A procedure that shows the new GUI
+(define (show)
+ (redraw))
+
+;; The colors to draw with:
+(define *red-pen*
+ (send the-pen-list find-or-create-pen "red" 4 'solid))
+(define *green-pen*
+ (send the-pen-list find-or-create-pen "green" 2 'solid))
+(define *black-pen*
+ (send the-pen-list find-or-create-pen "black" 2 'solid))
+(define *blue-pen*
+ (send the-pen-list find-or-create-pen "blue" 2 'solid))
+(define *yellow-pen*
+ (send the-pen-list find-or-create-pen "yellow" 2 'solid))
+(define *white-pen*
+ (send the-pen-list find-or-create-pen "white" 2 'solid))
+
+(define *yellow-brush*
+ (send the-brush-list find-or-create-brush "yellow" 'solid))
+(define *red-brush*
+ (send the-brush-list find-or-create-brush "red" 'solid))
+(define *blue-brush*
+ (send the-brush-list find-or-create-brush "blue" 'solid))
+(define *green-brush*
+ (send the-brush-list find-or-create-brush "green" 'solid))
+(define *white-brush*
+ (send the-brush-list find-or-create-brush "white" 'solid))
+(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)
+;; --------------------------------------------------------------------
+
+(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%
+ (*frame*)))
+
+(define *menu*
+ (instantiate menu%
+ ("Menu" *menu-bar*)))
+
+(instantiate menu-item%
+ ("Quit" *menu* (lambda (a b) (hide-gui *gui*))))
+
+(define *canvas*
+ (instantiate my-canvas% ()
+ (parent *frame*)
+ (paint-callback draw-canvas)
+ (key-callback key-fn)
+ (min-height 672)
+ (min-width 672)
+ (stretchable-width #f)
+ (stretchable-height #f)))
+
+(define *buffer* (make-object bitmap% 832 832 #f))
+(define *dc* (make-object bitmap-dc% *buffer*))
+
+(define *gui*
+ (make-gui
+ *frame*
+ *canvas*
+ *buffer*
+ *dc*))
+
+
Please sign in to comment.
Something went wrong with that request. Please try again.