mbk/mineschemer
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

wiggle proof

Browse source
This commit is contained in:
mehbark 2023-12-23 13:22:25 -05:00
parent d981990978
commit 4f0756cbe9
1 changed files with 30 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
main.scm
View file

@ -158,25 +158,39 @@
(define (set-vector2-x! vec2 x) (ftype-set! Vector2 (x) vec2 (exact->inexact x))) (define (set-vector2-x! vec2 x) (ftype-set! Vector2 (x) vec2 (exact->inexact x)))
(define (set-vector2-y! vec2 y) (ftype-set! Vector2 (y) vec2 (exact->inexact y))) (define (set-vector2-y! vec2 y) (ftype-set! Vector2 (y) vec2 (exact->inexact y)))
(define (vector2-x vec2) (ftype-ref Vector2 (x) vec2))
(define (vector2-y vec2) (ftype-ref Vector2 (y) vec2))
(define (vector2 x y) (define (vector2 x y)
(define vec2 (make-ftype-pointer Vector2 (foreign-alloc (ftype-sizeof Vector2)))) (define vec2 (make-ftype-pointer Vector2 (foreign-alloc (ftype-sizeof Vector2))))
(set-vector2-x! vec2 x) (set-vector2-x! vec2 x)
(set-vector2-y! vec2 y) (set-vector2-y! vec2 y)
vec2) vec2)
(define (vector2+-bin a b)
(vector2 (+ (vector2-x a)
(vector2-x b))
(+ (vector2-y a)
(vector2-y b))))
(define (vector2+ . vs)
(fold-left vector2+-bin
(vector2 0 0)
vs))
; adapted from https://github.com/Yunoinsky/chez-raylib/blob/main/src/raylib.sls ; adapted from https://github.com/Yunoinsky/chez-raylib/blob/main/src/raylib.sls
(define load-image (define load-image
(let ([f (foreign-procedure #f "LoadImage" (let ([f (foreign-procedure #f "LoadImage"
(string) (string)
(& Image))]) (& Image))])
(case-lambda (case-lambda
[(file-name) [(file-name)
(let ([ret (make-ftype-pointer (let ([ret (make-ftype-pointer
Image Image
(foreign-alloc (ftype-sizeof Image)))]) (foreign-alloc (ftype-sizeof Image)))])
(f ret file-name) (f ret file-name)
ret)] ret)]
[(struct file-name) (f struct file-name) struct]))) [(struct file-name) (f struct file-name) struct])))
(define load-texture (define load-texture
(let ([f (foreign-procedure #f "LoadTexture" (let ([f (foreign-procedure #f "LoadTexture"
@ -368,10 +382,11 @@
gap gap
gap)) gap))
(define *t* 0.0)
(define (blit-from-skin skin rect pos) (define (blit-from-skin skin rect pos)
;; (display skin) (display " ") (display rect) (display " ") (display pos) ;; (display skin) (display " ") (display rect) (display " ") (display pos)
;; (newline) ;; (newline)
(draw-texture-rec skin rect pos WHITE)) (draw-texture-rec skin rect (vector2+ pos (vector2 (* (random 4) (sin *t*)) (* (random 4) (cos *t*)))) WHITE))
(define (blit-number skin n pos) (define (blit-number skin n pos)
(let ([rect (vector-ref number-rects n)]) (let ([rect (vector-ref number-rects n)])
@ -443,9 +458,12 @@
; with the actual game, we almost certainly don't have to redraw everything every time ; with the actual game, we almost certainly don't have to redraw everything every time
(until (window-should-close?) (until (window-should-close?)
(set! h (+ 1 h)) (set! h (+ 1 h))
(set! *t* (+ *t* (get-frame-time)))
(with-draw (with-draw
(clear-background (color-from-hsv h 1.0 1.0)) (clear-background (color-from-hsv h 1.0 1.0))
(redraw-skin skin))) (redraw-skin skin)))
(unload-texture skin) (unload-texture skin)
(close-window))) (close-window)))
; let's save playing with shaders for later