Compare commits
2 Commits
a2ac0c10b2
...
5ce7aaf7de
| Author | SHA1 | Date |
|---|---|---|
|
|
5ce7aaf7de | |
|
|
0951c240bc |
6
Makefile
6
Makefile
|
|
@ -35,7 +35,7 @@ init-venv: build
|
|||
rm -rf venv
|
||||
scheme-venv ${SCHEME} ${RNRS} venv
|
||||
echo "(import (scheme base) (scheme write) (scheme read) (scheme char) (scheme file) (scheme process-context) (srfi 64) (retropikzel ${LIBRARY}))" > venv/test.scm
|
||||
printf "#!r6rs\n(import (rnrs) (srfi :64) (retropikzel ${LIBRARY}))" > venv/test.sps
|
||||
printf "#!r6rs\n(import (except (rnrs) remove) (srfi :64) (retropikzel ${LIBRARY}))" > venv/test.sps
|
||||
cat ${TESTFILE} >> venv/test.scm
|
||||
cat ${TESTFILE} >> venv/test.sps
|
||||
if [ "${RNRS}" = "r6rs" ]; then if [ -d ../foreign-c ]; then cp -r ../foreign-c/foreign venv/lib/; fi; fi
|
||||
|
|
@ -51,7 +51,7 @@ init-venv: build
|
|||
|
||||
run-test: init-venv
|
||||
if [ "${RNRS}" = "r6rs" ]; then ./venv/bin/scheme-compile venv/test.sps; fi
|
||||
if [ "${RNRS}" = "r7rs" ]; then CSC_OPTIONS="-L -lcurl" ./venv/bin/scheme-compile venv/test.scm; fi
|
||||
if [ "${RNRS}" = "r7rs" ]; then CSC_OPTIONS="-L -lcurl -L -lSDL2 -L -lSDL2_image" ./venv/bin/scheme-compile venv/test.scm; fi
|
||||
./venv/test
|
||||
|
||||
test-r7rs:
|
||||
|
|
@ -73,7 +73,7 @@ example-r7rs: example.scm
|
|||
./example
|
||||
|
||||
test-r6rs:
|
||||
echo "(import (rnrs) (foreign c) (retropikzel ${LIBRARY}) (srfi :64))" > test-r6rs.sps
|
||||
echo "(import (except (rnrs) remove) (foreign c) (retropikzel ${LIBRARY}) (srfi :64))" > test-r6rs.sps
|
||||
cat retropikzel/${LIBRARY}/test.scm >> test-r6rs.sps
|
||||
akku install chez-srfi akku-r7rs
|
||||
COMPILE_R7RS=${SCHEME} timeout 60 compile-scheme -I .akku/lib -o test-r6rs test-r6rs.sps
|
||||
|
|
|
|||
|
|
@ -1,22 +1,22 @@
|
|||
(define-c-library libc '("stdio.h") #f '())
|
||||
(define-c-procedure fopen libc 'fopen 'pointer '(pointer pointer))
|
||||
(define-c-procedure fclose libc 'fclose 'int '(pointer))
|
||||
(define-c-procedure feof 'feof 'int '(pointer))
|
||||
(define-c-procedure ferror 'ferror 'int '(pointer))
|
||||
(define-c-procedure fgetc 'fgetc 'int '(pointer))
|
||||
(define-c-procedure fgetcs 'fgetcs 'pointer '(pointer int pointer))
|
||||
(define-c-procedure fputc 'fputc 'int '(int pointer))
|
||||
(define-c-procedure fputs 'fputs 'int '(pointer pointer))
|
||||
(define-c-procedure fread 'fread 'int '(pointer int int pointer))
|
||||
(define-c-procedure fseek 'fseek 'int '(pointer long int))
|
||||
(define-c-procedure ftell 'ftell 'long '(pointer))
|
||||
(define-c-procedure fwrite 'fwrite 'int '(pointer int int pointer))
|
||||
(define-c-procedure getc 'fwrite 'int '(pointer))
|
||||
(define-c-procedure getchar 'getchar 'int '())
|
||||
(define-c-procedure putc 'putc 'int '(int pointer))
|
||||
(define-c-procedure putchar 'putchar 'int '(int))
|
||||
(define-c-procedure puts 'puts 'int '(pointer))
|
||||
(define-c-procedure remove 'remove 'int '(pointer))
|
||||
(define-c-procedure rename 'rename 'int '(pointer pointer))
|
||||
(define-c-procedure rewind 'rewind 'int '(pointer))
|
||||
(define-c-procedure feof libc 'feof 'int '(pointer))
|
||||
(define-c-procedure ferror libc 'ferror 'int '(pointer))
|
||||
(define-c-procedure fgetc libc 'fgetc 'int '(pointer))
|
||||
(define-c-procedure fgets libc 'fgets 'pointer '(pointer int pointer))
|
||||
(define-c-procedure fputc libc 'fputc 'int '(int pointer))
|
||||
(define-c-procedure fputs libc 'fputs 'int '(pointer pointer))
|
||||
(define-c-procedure fread libc 'fread 'int '(pointer int int pointer))
|
||||
(define-c-procedure fseek libc 'fseek 'int '(pointer long int))
|
||||
(define-c-procedure ftell libc 'ftell 'long '(pointer))
|
||||
(define-c-procedure fwrite libc 'fwrite 'int '(pointer int int pointer))
|
||||
(define-c-procedure getc libc 'getc 'int '(pointer))
|
||||
(define-c-procedure getchar libc 'getchar 'int '())
|
||||
(define-c-procedure putc libc 'putc 'int '(int pointer))
|
||||
(define-c-procedure putchar libc 'putchar 'int '(int))
|
||||
(define-c-procedure puts libc 'puts 'int '(pointer))
|
||||
(define-c-procedure remove libc 'remove 'int '(pointer))
|
||||
(define-c-procedure rename libc 'rename 'int '(pointer pointer))
|
||||
(define-c-procedure rewind libc 'rewind 'void '(pointer))
|
||||
|
||||
|
|
|
|||
|
|
@ -41,7 +41,6 @@
|
|||
(define-c-procedure sdl-render-draw-rect sdl2* 'SDL_RenderDrawRect 'int '(pointer pointer))
|
||||
(define-c-procedure sdl-render-fill-rect sdl2* 'SDL_RenderFillRect 'int '(pointer pointer))
|
||||
(define-c-procedure sdl-render-set-scale sdl2* 'SDL_RenderSetScale 'int '(pointer float float))
|
||||
(define-c-procedure sdl-render-fill-rect sdl2* 'SDL_RenderFillRect 'int '(pointer pointer))
|
||||
(define-c-procedure sdl-create-texture-from-surface sdl2* 'SDL_CreateTextureFromSurface 'pointer '(pointer pointer))
|
||||
(define-c-procedure sdl-set-window-resizable sdl2* 'SDL_SetWindowResizable 'void '(pointer int))
|
||||
(define-c-procedure sdl-render-get-scale sdl2* 'SDL_RenderGetScale 'void '(pointer pointer pointer))
|
||||
|
|
@ -52,21 +51,23 @@
|
|||
(define event* (make-c-bytevector 4000))
|
||||
(define draw-rect* (make-c-bytevector (* (c-type-size 'int) 4)))
|
||||
(define draw-slice-rect* (make-c-bytevector (* (c-type-size 'int) 4)))
|
||||
(define fill-triangle-vertex-size 128 #;(+ (* (c-type-size 'int) 6) (* (c-type-size 'float) 2)))
|
||||
(define fill-triangle-vertex-size 128) ;(+ (* (c-type-size 'int) 6) (* (c-type-size 'float) 2))
|
||||
(define fill-triangle-vertex1* (make-c-bytevector fill-triangle-vertex-size 0))
|
||||
(define fill-triangle-vertex2* (make-c-bytevector fill-triangle-vertex-size 0))
|
||||
(define fill-triangle-vertex3* (make-c-bytevector fill-triangle-vertex-size 0))
|
||||
(define fill-triangle-vertexes* (make-c-bytevector (* fill-triangle-vertex-size 3 0)))
|
||||
(c-bytevector-pointer-set! fill-triangle-vertexes*
|
||||
(* fill-triangle-vertex-size 0)
|
||||
fill-triangle-vertex1*)
|
||||
(c-bytevector-pointer-set! fill-triangle-vertexes*
|
||||
(* fill-triangle-vertex-size 1)
|
||||
fill-triangle-vertex2*)
|
||||
(c-bytevector-pointer-set! fill-triangle-vertexes*
|
||||
(* fill-triangle-vertex-size 2)
|
||||
fill-triangle-vertex3*)
|
||||
(define null* (make-c-null))
|
||||
(c-bytevector-set! fill-triangle-vertexes*
|
||||
'pointer
|
||||
(* fill-triangle-vertex-size 0)
|
||||
fill-triangle-vertex1*)
|
||||
(c-bytevector-set! fill-triangle-vertexes*
|
||||
'pointer
|
||||
(* fill-triangle-vertex-size 1)
|
||||
fill-triangle-vertex2*)
|
||||
(c-bytevector-set! fill-triangle-vertexes*
|
||||
'pointer
|
||||
(* fill-triangle-vertex-size 2)
|
||||
fill-triangle-vertex3*)
|
||||
|
||||
(define update-procedure #f)
|
||||
(define draw-procedure #f)
|
||||
|
|
@ -86,7 +87,7 @@
|
|||
|
||||
(define sdl2-event->spite-event
|
||||
(lambda (event)
|
||||
(let ((type (c-bytevector-sint-ref event 0 (native-endianness) (c-type-size 'int))))
|
||||
(let ((type (c-bytevector-ref event 'int 0)))
|
||||
(cond
|
||||
((= type 256)
|
||||
(let ((type 'quit))
|
||||
|
|
@ -94,17 +95,17 @@
|
|||
((or (= type 768) (= type 769))
|
||||
(let*
|
||||
((type (if (= type 768) 'key-down 'key-up))
|
||||
(scancode (c-bytevector-sint-ref event
|
||||
(+ (* (c-type-size 'int) 3)
|
||||
(* (c-type-size 'uint8) 4))
|
||||
(native-endianness)
|
||||
(c-type-size 'int)))
|
||||
(scancode (c-bytevector-ref event
|
||||
'int
|
||||
(+ (* (c-type-size 'int) 3)
|
||||
(* (c-type-size 'u8) 4))))
|
||||
(keycode (sdl-get-key-from-scancode scancode))
|
||||
(key (c-utf8->string (sdl-get-key-name keycode)))
|
||||
(repeat? (= (c-bytevector-u8-ref
|
||||
(key (c-bytevector->string (sdl-get-key-name keycode)))
|
||||
(repeat? (= (c-bytevector-ref
|
||||
event
|
||||
'u8
|
||||
(+ (* (c-type-size 'int) 3)
|
||||
(c-type-size 'uint8)))
|
||||
(c-type-size 'u8)))
|
||||
1)))
|
||||
(list (cons 'type type)
|
||||
(cons 'key key)
|
||||
|
|
@ -112,39 +113,34 @@
|
|||
(cons 'repeat? repeat?))))
|
||||
((= type 1024)
|
||||
(let ((type 'mouse-motion)
|
||||
(x (c-bytevector-sint-ref event
|
||||
(+ (* (c-type-size 'int) 5))
|
||||
(native-endianness)
|
||||
(c-type-size 'int)))
|
||||
(y (c-bytevector-sint-ref event
|
||||
(+ (* (c-type-size 'int) 6))
|
||||
(native-endianness)
|
||||
(c-type-size 'int))))
|
||||
(x (c-bytevector-ref event
|
||||
'int
|
||||
(+ (* (c-type-size 'int) 5))
|
||||
))
|
||||
(y (c-bytevector-ref event
|
||||
'int
|
||||
(+ (* (c-type-size 'int) 6)))))
|
||||
(list (cons 'type type)
|
||||
(cons 'x x)
|
||||
(cons 'y y))))
|
||||
((or (= type 1025) (= type 1026))
|
||||
(let ((type (if (= type 1025) 'mouse-button-down 'mouse-button-up))
|
||||
(x (c-bytevector-sint-ref event
|
||||
(+ (* (c-type-size 'int) 4)
|
||||
(* (c-type-size 'uint8) 4))
|
||||
(native-endianness)
|
||||
(c-type-size 'int)))
|
||||
(y (c-bytevector-sint-ref event
|
||||
(+ (* (c-type-size 'int) 4)
|
||||
(* (c-type-size 'uint8) 4)
|
||||
(c-type-size 'int))
|
||||
(native-endianness)
|
||||
(c-type-size 'int)))
|
||||
(button (c-bytevector-sint-ref event
|
||||
(+ (* (c-type-size 'uint32) 4))
|
||||
(native-endianness)
|
||||
(c-type-size 'uint8)))
|
||||
(clicks (c-bytevector-sint-ref event
|
||||
(+ (* (c-type-size 'uint32) 4)
|
||||
(* (c-type-size 'uint8) 2))
|
||||
(native-endianness)
|
||||
(c-type-size 'uint8))))
|
||||
(x (c-bytevector-ref event
|
||||
'int
|
||||
(+ (* (c-type-size 'int) 4)
|
||||
(* (c-type-size 'u8) 4))))
|
||||
(y (c-bytevector-ref event
|
||||
'int
|
||||
(+ (* (c-type-size 'int) 4)
|
||||
(* (c-type-size 'u8) 4)
|
||||
(c-type-size 'int))))
|
||||
(button (c-bytevector-ref event
|
||||
'int
|
||||
(+ (* (c-type-size 'u32) 4))))
|
||||
(clicks (c-bytevector-ref event
|
||||
'int
|
||||
(+ (* (c-type-size 'u32) 4)
|
||||
(* (c-type-size 'u8) 2)))))
|
||||
(list (cons 'type type)
|
||||
(cons 'x x)
|
||||
(cons 'y y)
|
||||
|
|
@ -185,26 +181,26 @@
|
|||
(when (not spite-inited?) (error "Can not load images until spite is inited." path))
|
||||
(when (not (string? path)) (error "Load path must be string" path))
|
||||
(when (not (file-exists? path)) (error (string-append "Could not load image, no such file: " path)))
|
||||
(make-image (sdl-img-load-texture renderer* (string->c-utf8 path)) path)))
|
||||
(make-image (sdl-img-load-texture renderer* (string->c-bytevector path)) path)))
|
||||
|
||||
(define draw-image
|
||||
(lambda (image x y width height)
|
||||
(c-bytevector-sint-set! draw-rect* (* (c-type-size 'int) 0) x (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! draw-rect* (* (c-type-size 'int) 1) y (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! draw-rect* (* (c-type-size 'int) 2) width (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! draw-rect* (* (c-type-size 'int) 3) height (native-endianness) (c-type-size 'int))
|
||||
(sdl-render-copy renderer* (image-pointer image) (make-c-null) draw-rect*)))
|
||||
(c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 0) x)
|
||||
(c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 1) y)
|
||||
(c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 2) width)
|
||||
(c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 3) height)
|
||||
(sdl-render-copy renderer* (image-pointer image) (c-bytevector-null) draw-rect*)))
|
||||
|
||||
(define draw-image-slice
|
||||
(lambda (image x y width height slice-x slice-y slice-width slice-height)
|
||||
(c-bytevector-sint-set! draw-rect* (* (c-type-size 'int) 0) x (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! draw-rect* (* (c-type-size 'int) 1) y (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! draw-rect* (* (c-type-size 'int) 2) width (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! draw-rect* (* (c-type-size 'int) 3) height (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! draw-slice-rect* (* (c-type-size 'int) 0) slice-x (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! draw-slice-rect* (* (c-type-size 'int) 1) slice-y (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! draw-slice-rect* (* (c-type-size 'int) 2) slice-width (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! draw-slice-rect* (* (c-type-size 'int) 3) slice-height (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 0) x)
|
||||
(c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 1) y)
|
||||
(c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 2) width)
|
||||
(c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 3) height)
|
||||
(c-bytevector-set! draw-slice-rect* 'int (* (c-type-size 'int) 0) slice-x)
|
||||
(c-bytevector-set! draw-slice-rect* 'int (* (c-type-size 'int) 1) slice-y)
|
||||
(c-bytevector-set! draw-slice-rect* 'int (* (c-type-size 'int) 2) slice-width)
|
||||
(c-bytevector-set! draw-slice-rect* 'int (* (c-type-size 'int) 3) slice-height)
|
||||
(sdl-render-copy renderer* (image-pointer image) draw-slice-rect* draw-rect*)))
|
||||
|
||||
(define (set-draw-color r g b . a)
|
||||
|
|
@ -213,20 +209,20 @@
|
|||
(set! draw-color-b b)
|
||||
(set! draw-color-a (if (null? a) 255 a))
|
||||
|
||||
(c-bytevector-sint-set! fill-triangle-vertex1* (* (c-type-size 'int) 2) draw-color-r (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! fill-triangle-vertex1* (* (c-type-size 'int) 3) draw-color-g (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! fill-triangle-vertex1* (* (c-type-size 'int) 4) draw-color-b (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! fill-triangle-vertex1* (* (c-type-size 'int) 5) draw-color-b (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-set! fill-triangle-vertex1* 'int (* (c-type-size 'int) 2) draw-color-r)
|
||||
(c-bytevector-set! fill-triangle-vertex1* 'int (* (c-type-size 'int) 3) draw-color-g)
|
||||
(c-bytevector-set! fill-triangle-vertex1* 'int (* (c-type-size 'int) 4) draw-color-b)
|
||||
(c-bytevector-set! fill-triangle-vertex1* 'int (* (c-type-size 'int) 5) draw-color-b)
|
||||
|
||||
(c-bytevector-sint-set! fill-triangle-vertex2* (* (c-type-size 'int) 2) draw-color-r (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! fill-triangle-vertex2* (* (c-type-size 'int) 3) draw-color-g (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! fill-triangle-vertex2* (* (c-type-size 'int) 4) draw-color-b (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! fill-triangle-vertex2* (* (c-type-size 'int) 5) draw-color-b (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-set! fill-triangle-vertex2* 'int (* (c-type-size 'int) 2) draw-color-r)
|
||||
(c-bytevector-set! fill-triangle-vertex2* 'int (* (c-type-size 'int) 3) draw-color-g)
|
||||
(c-bytevector-set! fill-triangle-vertex2* 'int (* (c-type-size 'int) 4) draw-color-b)
|
||||
(c-bytevector-set! fill-triangle-vertex2* 'int (* (c-type-size 'int) 5) draw-color-b)
|
||||
|
||||
(c-bytevector-sint-set! fill-triangle-vertex3* (* (c-type-size 'int) 2) draw-color-r (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! fill-triangle-vertex3* (* (c-type-size 'int) 3) draw-color-g (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! fill-triangle-vertex3* (* (c-type-size 'int) 4) draw-color-b (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! fill-triangle-vertex3* (* (c-type-size 'int) 5) draw-color-b (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-set! fill-triangle-vertex3* 'int (* (c-type-size 'int) 2) draw-color-r)
|
||||
(c-bytevector-set! fill-triangle-vertex3* 'int (* (c-type-size 'int) 3) draw-color-g)
|
||||
(c-bytevector-set! fill-triangle-vertex3* 'int (* (c-type-size 'int) 4) draw-color-b)
|
||||
(c-bytevector-set! fill-triangle-vertex3* 'int (* (c-type-size 'int) 5) draw-color-b)
|
||||
|
||||
(sdl-set-render-draw-color renderer* r g b draw-color-a))
|
||||
|
||||
|
|
@ -237,7 +233,7 @@
|
|||
(define (draw-point x y)
|
||||
(sdl-render-draw-line renderer*
|
||||
(exact (round (/ x current-line-size)))
|
||||
(exact (round (/ y current-linesize)))
|
||||
(exact (round (/ y current-line-size)))
|
||||
(exact (round (/ x current-line-size)))
|
||||
(exact (round (/ y current-line-size)))))
|
||||
|
||||
|
|
@ -249,17 +245,17 @@
|
|||
(exact (round (/ y2 current-line-size)))))
|
||||
|
||||
(define (draw-rectangle x y width height)
|
||||
(c-bytevector-sint-set! draw-rect* (* (c-type-size 'int) 0) x (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! draw-rect* (* (c-type-size 'int) 1) y (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! draw-rect* (* (c-type-size 'int) 2) width (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! draw-rect* (* (c-type-size 'int) 3) height (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 0) x)
|
||||
(c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 1) y)
|
||||
(c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 2) width)
|
||||
(c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 3) height)
|
||||
(sdl-render-draw-rect renderer* draw-rect*))
|
||||
|
||||
(define (fill-rectangle x y width height)
|
||||
(c-bytevector-sint-set! draw-rect* (* (c-type-size 'int) 0) x (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! draw-rect* (* (c-type-size 'int) 1) y (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! draw-rect* (* (c-type-size 'int) 2) width (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! draw-rect* (* (c-type-size 'int) 3) height (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 0) x)
|
||||
(c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 1) y)
|
||||
(c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 2) width)
|
||||
(c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 3) height)
|
||||
(sdl-render-fill-rect renderer* draw-rect*))
|
||||
|
||||
(define (draw-triangle x1 y1 x2 y2 x3 y3)
|
||||
|
|
@ -269,16 +265,16 @@
|
|||
|
||||
;; FIXME
|
||||
#;(define (fill-triangle x1 y1 x2 y2 x3 y3)
|
||||
(c-bytevector-sint-set! fill-triangle-vertex1* (* (c-type-size 'int) 0) x1 (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! fill-triangle-vertex1* (* (c-type-size 'int) 1) y1 (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-set! fill-triangle-vertex1* 'int (* (c-type-size 'int) 0) x1)
|
||||
(c-bytevector-set! fill-triangle-vertex1* 'int (* (c-type-size 'int) 1) y1)
|
||||
|
||||
(c-bytevector-sint-set! fill-triangle-vertex2* (* (c-type-size 'int) 0) x2 (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! fill-triangle-vertex2* (* (c-type-size 'int) 1) y2 (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-set! fill-triangle-vertex2* 'int (* (c-type-size 'int) 0) x2)
|
||||
(c-bytevector-set! fill-triangle-vertex2* 'int (* (c-type-size 'int) 1) y2)
|
||||
|
||||
(c-bytevector-sint-set! fill-triangle-vertex3* (* (c-type-size 'int) 0) x3 (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-sint-set! fill-triangle-vertex3* (* (c-type-size 'int) 1) y3 (native-endianness) (c-type-size 'int))
|
||||
(c-bytevector-set! fill-triangle-vertex3* 'int (* (c-type-size 'int) 0) x3)
|
||||
(c-bytevector-set! fill-triangle-vertex3* 'int (* (c-type-size 'int) 1) y3)
|
||||
|
||||
(sdl-render-geometry renderer* (make-c-null) fill-triangle-vertexes* 3 (make-c-null) 0))
|
||||
(sdl-render-geometry renderer* (c-bytevector-null) fill-triangle-vertexes* 3 (c-bytevector-null) 0))
|
||||
|
||||
(define (spite-option-set! name . value)
|
||||
(cond
|
||||
|
|
@ -304,8 +300,8 @@
|
|||
(let ((x (make-c-bytevector (c-type-size 'float)))
|
||||
(y (make-c-bytevector (c-type-size 'float))))
|
||||
(sdl-render-get-scale renderer* x y)
|
||||
(list (cons 'x (c-bytevector-ieee-single-ref x 0 (native-endianness)))
|
||||
(cons 'y (c-bytevector-ieee-single-ref y 0 (native-endianness)))))))
|
||||
(list (cons 'x (c-bytevector-ref x 'float 0))
|
||||
(cons 'y (c-bytevector-ref y 'float 0))))))
|
||||
|
||||
(define spite-start
|
||||
(lambda (new-update-procedure new-draw-procedure)
|
||||
|
|
@ -321,7 +317,7 @@
|
|||
(cond
|
||||
((not started?)
|
||||
(sdl-init 32)
|
||||
(set! window* (sdl-create-window (string->c-utf8 title) 0 0 width height 4))
|
||||
(set! window* (sdl-create-window (string->c-bytevector title) 0 0 width height 4))
|
||||
(set! renderer* (sdl-create-renderer window* -1 2))
|
||||
(sdl-render-setlogial-size renderer* width height)
|
||||
(sdl-render-set-integer-scale renderer* 1)
|
||||
|
|
@ -343,7 +339,7 @@
|
|||
|
||||
(define push-event
|
||||
(lambda (event)
|
||||
(set! events (append events (list event)))))
|
||||
(set! events (append events (list event)))))
|
||||
|
||||
(define clear-events!
|
||||
(lambda ()
|
||||
|
|
|
|||
|
|
@ -0,0 +1,165 @@
|
|||
GNU LESSER GENERAL PUBLIC LICENSE
|
||||
Version 3, 29 June 2007
|
||||
|
||||
Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
|
||||
Everyone is permitted to copy and distribute verbatim copies
|
||||
of this license document, but changing it is not allowed.
|
||||
|
||||
|
||||
This version of the GNU Lesser General Public License incorporates
|
||||
the terms and conditions of version 3 of the GNU General Public
|
||||
License, supplemented by the additional permissions listed below.
|
||||
|
||||
0. Additional Definitions.
|
||||
|
||||
As used herein, "this License" refers to version 3 of the GNU Lesser
|
||||
General Public License, and the "GNU GPL" refers to version 3 of the GNU
|
||||
General Public License.
|
||||
|
||||
"The Library" refers to a covered work governed by this License,
|
||||
other than an Application or a Combined Work as defined below.
|
||||
|
||||
An "Application" is any work that makes use of an interface provided
|
||||
by the Library, but which is not otherwise based on the Library.
|
||||
Defining a subclass of a class defined by the Library is deemed a mode
|
||||
of using an interface provided by the Library.
|
||||
|
||||
A "Combined Work" is a work produced by combining or linking an
|
||||
Application with the Library. The particular version of the Library
|
||||
with which the Combined Work was made is also called the "Linked
|
||||
Version".
|
||||
|
||||
The "Minimal Corresponding Source" for a Combined Work means the
|
||||
Corresponding Source for the Combined Work, excluding any source code
|
||||
for portions of the Combined Work that, considered in isolation, are
|
||||
based on the Application, and not on the Linked Version.
|
||||
|
||||
The "Corresponding Application Code" for a Combined Work means the
|
||||
object code and/or source code for the Application, including any data
|
||||
and utility programs needed for reproducing the Combined Work from the
|
||||
Application, but excluding the System Libraries of the Combined Work.
|
||||
|
||||
1. Exception to Section 3 of the GNU GPL.
|
||||
|
||||
You may convey a covered work under sections 3 and 4 of this License
|
||||
without being bound by section 3 of the GNU GPL.
|
||||
|
||||
2. Conveying Modified Versions.
|
||||
|
||||
If you modify a copy of the Library, and, in your modifications, a
|
||||
facility refers to a function or data to be supplied by an Application
|
||||
that uses the facility (other than as an argument passed when the
|
||||
facility is invoked), then you may convey a copy of the modified
|
||||
version:
|
||||
|
||||
a) under this License, provided that you make a good faith effort to
|
||||
ensure that, in the event an Application does not supply the
|
||||
function or data, the facility still operates, and performs
|
||||
whatever part of its purpose remains meaningful, or
|
||||
|
||||
b) under the GNU GPL, with none of the additional permissions of
|
||||
this License applicable to that copy.
|
||||
|
||||
3. Object Code Incorporating Material from Library Header Files.
|
||||
|
||||
The object code form of an Application may incorporate material from
|
||||
a header file that is part of the Library. You may convey such object
|
||||
code under terms of your choice, provided that, if the incorporated
|
||||
material is not limited to numerical parameters, data structure
|
||||
layouts and accessors, or small macros, inline functions and templates
|
||||
(ten or fewer lines in length), you do both of the following:
|
||||
|
||||
a) Give prominent notice with each copy of the object code that the
|
||||
Library is used in it and that the Library and its use are
|
||||
covered by this License.
|
||||
|
||||
b) Accompany the object code with a copy of the GNU GPL and this license
|
||||
document.
|
||||
|
||||
4. Combined Works.
|
||||
|
||||
You may convey a Combined Work under terms of your choice that,
|
||||
taken together, effectively do not restrict modification of the
|
||||
portions of the Library contained in the Combined Work and reverse
|
||||
engineering for debugging such modifications, if you also do each of
|
||||
the following:
|
||||
|
||||
a) Give prominent notice with each copy of the Combined Work that
|
||||
the Library is used in it and that the Library and its use are
|
||||
covered by this License.
|
||||
|
||||
b) Accompany the Combined Work with a copy of the GNU GPL and this license
|
||||
document.
|
||||
|
||||
c) For a Combined Work that displays copyright notices during
|
||||
execution, include the copyright notice for the Library among
|
||||
these notices, as well as a reference directing the user to the
|
||||
copies of the GNU GPL and this license document.
|
||||
|
||||
d) Do one of the following:
|
||||
|
||||
0) Convey the Minimal Corresponding Source under the terms of this
|
||||
License, and the Corresponding Application Code in a form
|
||||
suitable for, and under terms that permit, the user to
|
||||
recombine or relink the Application with a modified version of
|
||||
the Linked Version to produce a modified Combined Work, in the
|
||||
manner specified by section 6 of the GNU GPL for conveying
|
||||
Corresponding Source.
|
||||
|
||||
1) Use a suitable shared library mechanism for linking with the
|
||||
Library. A suitable mechanism is one that (a) uses at run time
|
||||
a copy of the Library already present on the user's computer
|
||||
system, and (b) will operate properly with a modified version
|
||||
of the Library that is interface-compatible with the Linked
|
||||
Version.
|
||||
|
||||
e) Provide Installation Information, but only if you would otherwise
|
||||
be required to provide such information under section 6 of the
|
||||
GNU GPL, and only to the extent that such information is
|
||||
necessary to install and execute a modified version of the
|
||||
Combined Work produced by recombining or relinking the
|
||||
Application with a modified version of the Linked Version. (If
|
||||
you use option 4d0, the Installation Information must accompany
|
||||
the Minimal Corresponding Source and Corresponding Application
|
||||
Code. If you use option 4d1, you must provide the Installation
|
||||
Information in the manner specified by section 6 of the GNU GPL
|
||||
for conveying Corresponding Source.)
|
||||
|
||||
5. Combined Libraries.
|
||||
|
||||
You may place library facilities that are a work based on the
|
||||
Library side by side in a single library together with other library
|
||||
facilities that are not Applications and are not covered by this
|
||||
License, and convey such a combined library under terms of your
|
||||
choice, if you do both of the following:
|
||||
|
||||
a) Accompany the combined library with a copy of the same work based
|
||||
on the Library, uncombined with any other library facilities,
|
||||
conveyed under the terms of this License.
|
||||
|
||||
b) Give prominent notice with the combined library that part of it
|
||||
is a work based on the Library, and explaining where to find the
|
||||
accompanying uncombined form of the same work.
|
||||
|
||||
6. Revised Versions of the GNU Lesser General Public License.
|
||||
|
||||
The Free Software Foundation may publish revised and/or new versions
|
||||
of the GNU Lesser General Public License from time to time. Such new
|
||||
versions will be similar in spirit to the present version, but may
|
||||
differ in detail to address new problems or concerns.
|
||||
|
||||
Each version is given a distinguishing version number. If the
|
||||
Library as you received it specifies that a certain numbered version
|
||||
of the GNU Lesser General Public License "or any later version"
|
||||
applies to it, you have the option of following the terms and
|
||||
conditions either of that published version or of any later version
|
||||
published by the Free Software Foundation. If the Library as you
|
||||
received it does not specify a version number of the GNU Lesser
|
||||
General Public License, you may choose any version of the GNU Lesser
|
||||
General Public License ever published by the Free Software Foundation.
|
||||
|
||||
If the Library as you received it specifies that a proxy can decide
|
||||
whether future versions of the GNU Lesser General Public License shall
|
||||
apply, that proxy's public statement of acceptance of any version is
|
||||
permanent authorization for you to choose that version for the
|
||||
Library.
|
||||
|
|
@ -0,0 +1 @@
|
|||
0.1.0
|
||||
|
|
@ -52,7 +52,7 @@
|
|||
(draw-rectangle player-x player-y 64 64)
|
||||
(fill-rectangle (+ player-x 32) (+ player-y 32) 16 16)
|
||||
(draw-triangle 350 350 380 380 330 380)
|
||||
(fill-triangle 450 450 480 480 430 480)
|
||||
;(fill-triangle 450 450 480 480 430 480)
|
||||
))
|
||||
|
||||
(spite-start update draw)
|
||||
|
|
|
|||
Loading…
Reference in New Issue