summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2021-10-15 14:39:53 -0400
committerDavid Thompson <dthompson2@worcester.edu>2021-10-15 14:39:53 -0400
commitd0250dcd5ebe6de0bb7236b2805869ccd4d45537 (patch)
tree6c5a00e57a643614e00225b89c6f47606fac4584
parentdafd75249a4b4339eef9b72e15cdff51a14ff042 (diff)
Rename <canvas> to <display-2d> and <path> to <canvas>.
-rw-r--r--examples/tetra/tetra.scm14
-rw-r--r--starling/kernel.scm13
-rw-r--r--starling/minibuffer.scm2
-rw-r--r--starling/node-2d.scm64
-rw-r--r--starling/repl.scm2
-rw-r--r--starling/transition.scm8
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))