Add starfields and do a bunch of crap to make them actually feel nice

parent d8576e28
......@@ -3,7 +3,7 @@
(provide braille-configurations
brailleify-text
brailleify-text/list
brailleify-grid)
brailleify-grid/list)
(define braille-configurations
#hash((#(#f #f
......@@ -1059,7 +1059,7 @@
"No missing permutations"
missing-permutations (set)))
(define (brailleify-grid grid)
(define (brailleify-grid/list grid)
(define grid-height
(vector-length grid))
(define grid-width
......@@ -1101,7 +1101,7 @@
(define (brailleify-text/list text)
(define vectext
(vectorize-text text))
(brailleify-grid vectext))
(brailleify-grid/list vectext))
(define (brailleify-text text)
(string-join (brailleify-text/list text) "\n"))
......
......@@ -14,7 +14,8 @@
"level-tape.rkt"
"posinfo.rkt"
"raart-render.rkt"
"credits.rkt")
"credits.rkt"
"starfield.rkt")
(define render-layer-order
'(powerup
......@@ -109,7 +110,8 @@
(define (terrain-speed-char? char)
(hash-has-key? terrain-speed-control-chars char))
(define (^level bcom level-tape score-tracker lives)
(define (^level bcom level-tape score-tracker lives
#:starfield? [starfield? #t])
(define tape-eater
(spawn ^tape-eater level-tape))
......@@ -123,6 +125,13 @@
(define-cell exit-reason #f)
;; set up starfield, if appropriate
(define starfield
(and starfield?
(spawn ^starfield (* LEVEL-WIDTH 2) (* LEVEL-HEIGHT 4))))
(when starfield?
(prime-starfield starfield (* LEVEL-WIDTH 2)))
;; We add some extra methods to this ticky that let this object
;; do some things:
;; - Add points to the score on death
......@@ -393,8 +402,13 @@
[posinfo (add-to-layers posinfo layers)]))
#hasheq()))
(define backdrop-canvas
(if starfield?
($ starfield 'render)
blank-level-canvas))
(define level-canvas
(for/fold ([canvas blank-level-canvas])
(for/fold ([canvas backdrop-canvas])
([layer render-layer-order])
(for/fold ([canvas canvas])
([this-posinfo (hash-ref blit-layers layer '())])
......@@ -441,6 +455,9 @@
(methods
#:extends base-methods
[(tick)
(when starfield?
($ starfield 'advance ($ terrain-speed)))
(call/ec
(lambda (return)
;; maybe advance tape
......
#lang racket
(provide ^starfield prime-starfield)
(require "braille-rast.rkt"
goblins
goblins/actor-lib/methods
......@@ -40,9 +42,9 @@
(<= x 0))
(define (new-blink-on-time)
(* (random 1 100) .1))
(* (random 10 200) .1))
(define (new-blink-off-time)
(* (random 2 400) .1))
(* (random 300 1000) .1))
(define (make-new-star initial-distance)
(define y
......@@ -59,67 +61,63 @@
relative-speed on? blink-time))
(define (new-till-spawn)
(random 3 15))
(random 5 30))
(define (next till-spawn stars)
(methods
[(advance speed)
(cond
;; we don't advance
[(zero? speed)
'no-op]
[else
(define base-distance
(/ 1.0 speed))
(define new-stars
(for/fold ([new-stars (set)])
([this-star stars])
(define star-distance
(* base-distance (star-relative-speed this-star)))
(define new-x
(- (star-x this-star) star-distance))
(cond
;; drop this star
[(oob? new-x)
new-stars]
;; Otherwise, we'll add it back having updated some
;; properties
[else
(define blink-time
(- (star-blink-time this-star) star-distance))
(define on?
(star-on? this-star))
(when (<= blink-time 0)
(set! blink-time
(if on?
(new-blink-off-time)
(new-blink-on-time)))
(set! on? (not on?)))
(define new-star
(struct-copy star this-star
[x new-x]
[on? on?]
[blink-time blink-time]))
(set-add new-stars new-star)])))
(define next-till-spawn
(- till-spawn base-distance))
(when (<= next-till-spawn 0)
(set! new-stars (set-add new-stars (make-new-star base-distance)))
(set! next-till-spawn (new-till-spawn)))
(bcom (next next-till-spawn new-stars))])]
(define base-distance
(/ 1.0 (+ speed .1)))
(define new-stars
(for/fold ([new-stars (set)])
([this-star stars])
(define star-distance
(* base-distance (star-relative-speed this-star)))
(define new-x
(- (star-x this-star) star-distance))
(cond
;; drop this star
[(oob? new-x)
new-stars]
;; Otherwise, we'll add it back having updated some
;; properties
[else
(define blink-time
(- (star-blink-time this-star) star-distance))
(define on?
(star-on? this-star))
(when (<= blink-time 0)
(set! on? (not on?))
(set! blink-time
(if on?
(new-blink-off-time)
(new-blink-on-time))))
(define new-star
(struct-copy star this-star
[x new-x]
[on? on?]
[blink-time blink-time]))
(set-add new-stars new-star)])))
(define next-till-spawn
(- till-spawn base-distance))
(when (<= next-till-spawn 0)
(set! new-stars (set-add new-stars (make-new-star base-distance)))
(set! next-till-spawn (new-till-spawn)))
(bcom (next next-till-spawn new-stars))]
[(render)
(define grid
(make-vector height #f))
(for ([i height])
(vector-set! grid i (make-vector width #f)))
(for ([star stars])
(define y (star-y star))
(define x
(inexact->exact (floor (star-x star))))
(vector-set! (vector-ref grid (star-y star))
x 'SS))
(when (star-on? star)
(define y (star-y star))
(define x
(inexact->exact (floor (star-x star))))
(vector-set! (vector-ref grid (star-y star))
x 'SS)))
(define braille-lines
(brailleify-grid/list grid))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment