diff options
| -rw-r--r-- | examples/tetra/tetra.scm | 14 | ||||
| -rw-r--r-- | starling/kernel.scm | 13 | ||||
| -rw-r--r-- | starling/minibuffer.scm | 2 | ||||
| -rw-r--r-- | starling/node-2d.scm | 64 | ||||
| -rw-r--r-- | starling/repl.scm | 2 | ||||
| -rw-r--r-- | starling/transition.scm | 8 |
6 files changed, 52 insertions, 51 deletions
diff --git a/examples/tetra/tetra.scm b/examples/tetra/tetra.scm index f8a10d3..65e5a33 100644 --- a/examples/tetra/tetra.scm +++ b/examples/tetra/tetra.scm @@ -237,7 +237,7 @@ area next to the board." (if init? (teleport piece px py) (run-script piece - (move-to piece px py 8))))) + (move-to piece px py 0.1))))) (define-method (move-piece (piece <piece>) new-x new-y) (move-piece piece new-x new-y #f)) @@ -289,7 +289,7 @@ area next to the board." (define-method (on-clear (row <row>) particles) (run-script row - (scale-to row 0.0 0.0 10) + (scale-to row 0.0 0.0 0.25) (detach row)) ;; Emit some particles! woooooo (let* ((pos (position row)) @@ -330,7 +330,7 @@ area next to the board." (define-method (on-boot (board <board>)) (set! (batch board) (make-sprite-batch #f)) (attach-to board - (make <path> + (make <canvas> #:name 'background #:painter (with-style ((fill-color tango-aluminium-6)) (fill @@ -425,7 +425,7 @@ area next to the board." (define-method (remove-filled-rows (board <board>)) (let* ((rows (rows board)) (rows-to-remove (filled-rows board)) - (anim-duration 10)) + (anim-duration 0.25)) (let loop ((dead-rows rows-to-remove) (count 0)) (match dead-rows @@ -517,7 +517,7 @@ area next to the board." (/ container-width 2.0)) (/ (- window-height container-height) 2.0))))) (attach-to container - (make <path> + (make <canvas> #:name 'background #:painter (with-style ((fill-color tango-aluminium-6) (stroke-color tango-aluminium-3) @@ -571,7 +571,7 @@ area next to the board." (define-method (on-boot (tetra <tetra>)) (set! (board tetra) (make <board>)) (attach-to tetra - (make <path> + (make <canvas> #:painter (with-style ((fill-color tango-aluminium-5)) (fill (rectangle (vec2 0.0 0.0) window-width window-height)))) @@ -582,7 +582,7 @@ area next to the board." #:font click-font #:position (vec2 (centered-text text) 630.0) #:scale (vec2 2.0 2.0))) - (make <path> + (make <canvas> #:name 'next-background #:painter (with-style ((fill-color tango-aluminium-6)) (fill diff --git a/starling/kernel.scm b/starling/kernel.scm index 1aed4f3..42107b7 100644 --- a/starling/kernel.scm +++ b/starling/kernel.scm @@ -79,7 +79,7 @@ (define-class <fps-display> (<node>)) (define-method (on-boot (fps-display <fps-display>)) - (let* ((canvas (make <canvas> #:name 'canvas)) + (let* ((display (make <display-2d> #:name 'display)) (font (default-font)) (padding 4.0) (box-width (+ (font-line-width font "60.0") @@ -87,8 +87,8 @@ (box-height (+ (font-line-height font) (* padding 2.0)))) (call-with-values current-window-size (lambda (window-width window-height) - (attach-to canvas - (make <path> + (attach-to display + (make <canvas> #:painter (with-style ((fill-color (make-color 0 0 0 0.5))) (fill (rectangle (vec2 0.0 @@ -103,10 +103,10 @@ #:position (vec2 padding (+ (- window-height box-height) padding)))))) - (attach-to fps-display canvas))) + (attach-to fps-display display))) (define-method (update-fps (fps-display <fps-display>) fps) - (set! (text (& fps-display canvas fps-label)) + (set! (text (& fps-display display fps-label)) (format #f "~1,1f" fps))) @@ -367,7 +367,8 @@ (current-window (window kernel))) (activate kernel) (push-scene kernel (thunk)) - (run-game* #:update (lambda (dt) (update-tree kernel dt)) + (run-game* #:init (const #t) + #:update (lambda (dt) (update-tree kernel dt)) #:render (lambda (alpha) (render-tree kernel alpha)) #:error (lambda (stack key args) (on-error kernel stack key args)) diff --git a/starling/minibuffer.scm b/starling/minibuffer.scm index 9488530..b5b0d42 100644 --- a/starling/minibuffer.scm +++ b/starling/minibuffer.scm @@ -97,7 +97,7 @@ (line-height (font-line-height font)) (padding 8.0)) (attach-to minibuffer - (make <path> + (make <canvas> #:painter (with-style ((fill-color (make-color 0 0 0 0.7))) (fill (rectangle (vec2 0.0 0.0) diff --git a/starling/node-2d.scm b/starling/node-2d.scm index 71f43bf..257970e 100644 --- a/starling/node-2d.scm +++ b/starling/node-2d.scm @@ -55,7 +55,7 @@ point-within-camera-viewport? window-space->camera-space - <canvas> + <display-2d> cameras first-camera @@ -122,7 +122,7 @@ <sprite-batch> batch - <path> + <canvas> painter <label> @@ -234,39 +234,39 @@ ;;; -;;; 2D Canvas +;;; 2D Display ;;; -;; The canvas is the root of a 2D scene. It handles rendering one or -;; more cameras. +;; The display is the root of a 2D scene. It handles rendering all +;; child nodes from the perspective of one or more cameras. -(define-class <canvas> (<node>) +(define-class <display-2d> (<node>) (cameras #:accessor cameras #:init-form (list (make <camera-2d>)) #:init-keyword #:cameras)) -(define-method (render-tree (canvas <canvas>) alpha) - (render canvas alpha) +(define-method (render-tree (display <display-2d>) alpha) + (render display alpha) ;; Draw scene from the viewpoint of each camera. (for-each (lambda (camera) (with-camera camera (for-each-child (lambda (child) (render-tree child alpha)) - canvas))) - (cameras canvas))) + display))) + (cameras display))) -(define-method (first-camera (canvas <canvas>)) - (match (cameras canvas) +(define-method (first-camera (display <display-2d>)) + (match (cameras display) ((camera . _) camera) (() #f))) -(define-method (pick (canvas <canvas>) p pred) - (let camera-loop ((cams (cameras canvas))) +(define-method (pick (display <display-2d>) p pred) + (let camera-loop ((cams (cameras display))) (match cams (() #f) ((camera . rest) (if (point-within-camera-viewport? camera p) (let ((p* (window-space->camera-space camera p))) - (let loop ((kids (reverse (children canvas)))) + (let loop ((kids (reverse (children display)))) (match kids (() #f) ((child . rest) @@ -279,7 +279,7 @@ ;;; 2D Scene ;;; -(define-class <scene-2d> (<scene> <canvas>)) +(define-class <scene-2d> (<scene> <display-2d>)) ;;; @@ -590,7 +590,7 @@ #:init-form white) (blend-mode #:accessor blend-mode #:init-keyword #:blend-mode - #:init-form 'alpha)) + #:init-form blend:alpha)) (define-method (refresh-sprite-size (sprite <sprite>)) (let ((t (texture sprite))) @@ -740,7 +740,7 @@ (batch #:accessor batch #:init-keyword #:batch) (blend-mode #:accessor blend-mode #:init-keyword #:blend-mode - #:init-form 'alpha) + #:init-form blend:alpha) (clear-after-draw? #:accessor clear-after-draw? #:init-keyword #:clear-after-draw? #:init-form #t) @@ -758,33 +758,33 @@ ;;; Vector Path ;;; -(define-class <path> (<node-2d>) +(define-class <canvas> (<node-2d>) (painter #:accessor painter #:init-keyword #:painter #:watch? #t) (canvas #:accessor canvas #:init-thunk make-empty-canvas)) -(define-method (refresh-painter (path <path>)) - (let ((p (painter path)) +(define-method (refresh-painter (c <canvas>)) + (let ((p (painter c)) ;;(bb (painter-bounding-box p)) ) - (set-canvas-painter! (canvas path) (painter path)) - ;; (set! (origin-x path) (- (rect-x bb))) - ;; (set! (origin-y path) (- (rect-y bb))) - ;; (set! (width path) (rect-width bb)) - ;; (set! (height path) (rect-height bb)) + (set-canvas-painter! (canvas c) (painter c)) + ;; (set! (origin-x canvas) (- (rect-x bb))) + ;; (set! (origin-y canvas) (- (rect-y bb))) + ;; (set! (width canvas) (rect-width bb)) + ;; (set! (height canvas) (rect-height bb)) )) -(define-method (on-boot (path <path>)) - (refresh-painter path)) +(define-method (on-boot (c <canvas>)) + (refresh-painter c)) -(define-method (on-change (path <path>) slot-name old new) +(define-method (on-change (c <canvas>) slot-name old new) (case slot-name ((painter) - (refresh-painter path)) + (refresh-painter c)) (else (next-method)))) -(define-method (render (path <path>) alpha) - (draw-canvas* (canvas path) (world-matrix path))) +(define-method (render (c <canvas>) alpha) + (draw-canvas* (canvas c) (world-matrix c))) ;;; diff --git a/starling/repl.scm b/starling/repl.scm index 5e80854..c04341e 100644 --- a/starling/repl.scm +++ b/starling/repl.scm @@ -158,7 +158,7 @@ #:vertical-align 'top)) (iota nlines)))) (attach-to repl - (make <path> + (make <canvas> #:painter (with-style ((fill-color (make-color 0 0 0 0.7))) (fill (rectangle (vec2 0.0 0.0) diff --git a/starling/transition.scm b/starling/transition.scm index 7d28dce..76a3d27 100644 --- a/starling/transition.scm +++ b/starling/transition.scm @@ -92,11 +92,11 @@ (define-generic do-transition) (define-method (on-boot (transition <transition>)) - (attach-to transition (make <canvas> #:name 'canvas))) + (attach-to transition (make <display-2d> #:name 'display))) (define-method (on-enter (transition <transition>)) (script - (attach-to (& transition canvas) + (attach-to (& transition display) (scene-from transition) (scene-to transition)) (do-transition transition) @@ -108,7 +108,7 @@ (define-method (on-boot (fade <fade-transition>)) (next-method) - (attach-to (& fade canvas) + (attach-to (& fade display) (make <filled-rect> #:name 'rect #:region (make-rect 0.0 0.0 640.0 480.0) @@ -116,7 +116,7 @@ (define-method (do-transition (fade <fade-transition>)) (let ((half-duration (inexact->exact (round (/ (duration fade) 2)))) - (rect (& fade canvas rect))) + (rect (& fade display rect))) (define (set-alpha! alpha) (set! (color rect) (make-color 0 0 0 alpha))) (hide (scene-to fade)) |