Bring in spite
This commit is contained in:
parent
35da7bc0f0
commit
634fead8ce
|
|
@ -0,0 +1,386 @@
|
|||
(define spite-inited? #f)
|
||||
(define started? #f)
|
||||
(define exit? #f)
|
||||
(define scale-x 1.0)
|
||||
(define scale-y 1.0)
|
||||
(define events (list))
|
||||
(define current-bitmap-font #f)
|
||||
(define current-line-size 1)
|
||||
(define-c-library sdl2*
|
||||
'("SDL2/SDL.h")
|
||||
"SDL2-2.0"
|
||||
`((additional-paths ("retropikzel/spite"
|
||||
"snow/retropikzel/spite"))
|
||||
(additional-versions ("0"))))
|
||||
(define-c-library sdl2-image*
|
||||
'("SDL2/SDL_image.h")
|
||||
"SDL2_image-2.0"
|
||||
`((additional-paths ("retropikzel/spite"
|
||||
"snow/retropikzel/spite"))
|
||||
(additional-versions ("0"))))
|
||||
|
||||
(define-c-procedure sdl-init sdl2* 'SDL_Init 'int '(int))
|
||||
(define-c-procedure sdl-get-window-flags sdl2* 'SDL_GetWindowFlags 'int '(pointer))
|
||||
(define-c-procedure sdl-create-window sdl2* 'SDL_CreateWindow 'pointer '(pointer int int int int int))
|
||||
(define-c-procedure sdl-create-renderer sdl2* 'SDL_CreateRenderer 'pointer '(pointer int int))
|
||||
(define-c-procedure sdl-render-setlogial-size sdl2* 'SDL_RenderSetLogicalSize 'int '(pointer int int))
|
||||
(define-c-procedure sdl-render-set-integer-scale sdl2* 'SDL_RenderSetIntegerScale 'int '(pointer int))
|
||||
(define-c-procedure sdl-set-render-draw-color sdl2* 'SDL_SetRenderDrawColor 'int '(pointer int int int int))
|
||||
(define-c-procedure sdl-render-clear sdl2* 'SDL_RenderClear 'int '(pointer))
|
||||
(define-c-procedure sdl-render-present sdl2* 'SDL_RenderPresent 'void '(pointer))
|
||||
(define-c-procedure sdl-get-key-from-scancode sdl2* 'SDL_GetKeyFromScancode 'int '(int))
|
||||
(define-c-procedure sdl-get-key-name sdl2* 'SDL_GetKeyName 'pointer '(int))
|
||||
(define-c-procedure sdl-poll-event sdl2* 'SDL_PollEvent 'int '(pointer))
|
||||
(define-c-procedure sdl-img-load-texture sdl2-image* 'IMG_LoadTexture 'pointer '(pointer pointer))
|
||||
(define-c-procedure sdl-render-copy sdl2* 'SDL_RenderCopy 'int '(pointer pointer pointer pointer))
|
||||
(define-c-procedure sdl-render-draw-line sdl2* 'SDL_RenderDrawLine 'int '(pointer int int int int))
|
||||
(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))
|
||||
|
||||
(define window* #f)
|
||||
(define renderer* #f)
|
||||
(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 null* (make-c-null))
|
||||
|
||||
(define update-procedure #f)
|
||||
(define draw-procedure #f)
|
||||
|
||||
(define main-loop-start-time 0)
|
||||
(define delta-time 0)
|
||||
(define main-loop
|
||||
(lambda ()
|
||||
(set! main-loop-start-time (current-jiffy))
|
||||
(sdl2-events-get)
|
||||
(update-procedure delta-time (poll-events!))
|
||||
(render-clear)
|
||||
(draw-procedure)
|
||||
(render-present)
|
||||
(set! delta-time (/ (- (current-jiffy) main-loop-start-time) (jiffies-per-second)))
|
||||
(unless exit? (main-loop))))
|
||||
|
||||
(define sdl2-event->spite-event
|
||||
(lambda (event)
|
||||
(let ((type (c-bytevector-sint-ref event 0 (native-endianness) (c-type-size 'int))))
|
||||
(cond
|
||||
((= type 256)
|
||||
(let ((type 'quit))
|
||||
(list (cons 'type type))))
|
||||
((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)))
|
||||
(keycode (sdl-get-key-from-scancode scancode))
|
||||
(key (c-utf8->string (sdl-get-key-name keycode)))
|
||||
(repeat? (= (c-bytevector-u8-ref
|
||||
event
|
||||
(+ (* (c-type-size 'int) 3)
|
||||
(c-type-size 'uint8)))
|
||||
1)))
|
||||
(list (cons 'type type)
|
||||
(cons 'key key)
|
||||
(cons 'scancode scancode)
|
||||
(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))))
|
||||
(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))))
|
||||
(list (cons 'type type)
|
||||
(cons 'x x)
|
||||
(cons 'y y)
|
||||
(cons 'button button)
|
||||
(cons 'clicks clicks))))
|
||||
(else
|
||||
(list (cons 'type 'sdl2-event)
|
||||
(cons 'sdl2-type-number type)))))))
|
||||
|
||||
(define sdl2-events-get
|
||||
(lambda ()
|
||||
(let ((poll-result (sdl-poll-event event*)))
|
||||
(cond
|
||||
((= poll-result 1)
|
||||
(let ((event (sdl2-event->spite-event event*)))
|
||||
|
||||
(cond ((equal? (cdr (assoc 'type event)) 'quit) (set! exit? #t)))
|
||||
(push-event event)
|
||||
(sdl2-events-get)))))))
|
||||
|
||||
(define render-clear
|
||||
(lambda ()
|
||||
(sdl-set-render-draw-color renderer* 255 255 255 255)
|
||||
(sdl-render-clear renderer*)))
|
||||
|
||||
(define render-present
|
||||
(lambda ()
|
||||
(sdl-render-present renderer*)))
|
||||
|
||||
(define-record-type image
|
||||
(make-image pointer path)
|
||||
image?
|
||||
(pointer image-pointer)
|
||||
(path image-path))
|
||||
|
||||
(define load-image
|
||||
(lambda (path)
|
||||
(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)))
|
||||
|
||||
(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*)))
|
||||
|
||||
(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))
|
||||
(sdl-render-copy renderer* (image-pointer image) draw-slice-rect* draw-rect*)))
|
||||
|
||||
(define (set-draw-color r g b . a)
|
||||
(sdl-set-render-draw-color renderer* r g b (if (null? a) 255 (car a))))
|
||||
|
||||
(define (set-line-size size)
|
||||
(set! current-line-size size)
|
||||
(sdl-render-set-scale renderer* (inexact (/ size 1)) (inexact (/ size 1))))
|
||||
|
||||
(define (draw-point x y)
|
||||
(sdl-render-draw-line renderer*
|
||||
(exact (round (/ x current-line-size)))
|
||||
(exact (round (/ y current-linesize)))
|
||||
(exact (round (/ x current-line-size)))
|
||||
(exact (round (/ y current-line-size)))))
|
||||
|
||||
(define (draw-line x1 y1 x2 y2)
|
||||
(sdl-render-draw-line renderer*
|
||||
(exact (round (/ x1 current-line-size)))
|
||||
(exact (round (/ y1 current-line-size)))
|
||||
(exact (round (/ x2 current-line-size)))
|
||||
(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))
|
||||
(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))
|
||||
(sdl-render-fill-rect renderer* draw-rect*))
|
||||
|
||||
(define (spite-option-set! name . value)
|
||||
(cond
|
||||
((equal? name 'allow-window-resizing)
|
||||
(cond
|
||||
((equal? value '(#t))
|
||||
(sdl-set-window-resizable window* 1))
|
||||
((equal? value '(#f))
|
||||
(sdl-set-window-resizable window* 0))
|
||||
(else (error "Wrong option value for 'allow-window-resizing, must be #t or #f"
|
||||
value))))
|
||||
((equal? name 'renderer-size)
|
||||
(if (and (= (length value) 2)
|
||||
(number? (car value))
|
||||
(number? (cadr value)))
|
||||
(sdl-render-setlogial-size renderer* (car value) (cadr value))
|
||||
(error "Wrong option value for renderer-size, must be two numbers")))
|
||||
(else (error "No such option!" name))))
|
||||
|
||||
;; TODO Move to options, add spite-option-get
|
||||
(define spite-renderer-scale-get
|
||||
(lambda ()
|
||||
(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)))))))
|
||||
|
||||
(define spite-start
|
||||
(lambda (new-update-procedure new-draw-procedure)
|
||||
(set! update-procedure new-update-procedure)
|
||||
(set! draw-procedure new-draw-procedure)
|
||||
(cond
|
||||
((not started?)
|
||||
(set! started? #t)
|
||||
(main-loop)))))
|
||||
|
||||
(define spite-init
|
||||
(lambda (title width height)
|
||||
(cond
|
||||
((not started?)
|
||||
(sdl-init 32)
|
||||
(set! window* (sdl-create-window (string->c-utf8 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)
|
||||
(render-clear)
|
||||
(render-present)
|
||||
(set! spite-inited? #t)))))
|
||||
|
||||
(define poll-events!
|
||||
(lambda ()
|
||||
(let ((events-copy (list-copy events)))
|
||||
(set! events (list))
|
||||
events-copy)))
|
||||
|
||||
(define wait-for-event!
|
||||
(lambda ()
|
||||
(if (not (= (length events) 0))
|
||||
(poll-events!)
|
||||
(wait-for-event!))))
|
||||
|
||||
(define push-event
|
||||
(lambda (event)
|
||||
(set! events (append events (list event)))))
|
||||
|
||||
(define clear-events!
|
||||
(lambda ()
|
||||
(set! events (list))))
|
||||
|
||||
(define-record-type bitmap-font
|
||||
(internal-make-bitmap-font data)
|
||||
bitmap-font?
|
||||
(data bitmap-font-data))
|
||||
|
||||
(define (bitmap-font-get key bitmap)
|
||||
(cdr (assoc key (bitmap-font-data bitmap))))
|
||||
|
||||
(define-record-type bitmap-char
|
||||
(make-bitmap-char char x y)
|
||||
bitmap-char?
|
||||
(char bitmap-char-char)
|
||||
(x bitmap-char-x)
|
||||
(y bitmap-char-y))
|
||||
|
||||
(define (make-bitmap-font image character-width character-height draw-width draw-height character-lines)
|
||||
(let* ((line-items-count (string-length (car character-lines)))
|
||||
(characters (apply string-append character-lines))
|
||||
(index -1)
|
||||
(character-indexes (list))
|
||||
(character-positions
|
||||
(map (lambda (character)
|
||||
(set! index (+ index 1))
|
||||
(set! character-indexes (append character-indexes (list character index)))
|
||||
(list character
|
||||
(* (modulo index line-items-count)
|
||||
character-width)
|
||||
(* (floor (/ index line-items-count))
|
||||
character-height)))
|
||||
(string->list characters))))
|
||||
(internal-make-bitmap-font
|
||||
`((image . ,image)
|
||||
(character-width . ,character-width)
|
||||
(character-height . ,character-height)
|
||||
(character-draw-width . ,draw-width)
|
||||
(character-draw-height . ,draw-height)
|
||||
(line-items-count . ,line-items-count)
|
||||
(characters . ,characters)
|
||||
(character-indexes . ,character-indexes)
|
||||
(character-positions . ,character-positions)))))
|
||||
|
||||
(define (set-bitmap-font font)
|
||||
(set! current-bitmap-font font))
|
||||
|
||||
(define (make-bitmap-text text font)
|
||||
(map
|
||||
(lambda (c)
|
||||
(make-bitmap-char
|
||||
c
|
||||
(cadr (assq c (bitmap-font-get 'character-positions font)))
|
||||
(cadr (cdr (assq c (bitmap-font-get 'character-positions font))))))
|
||||
(string->list text)))
|
||||
|
||||
|
||||
(define draw-bitmap-text
|
||||
(lambda (text x y)
|
||||
(when (not current-bitmap-font)
|
||||
(error "Current bitmap font not set, use make-bitmap-font and set-bitmap-font"))
|
||||
(let ((offset-x x))
|
||||
(for-each
|
||||
(lambda (bitmap-char)
|
||||
(draw-image-slice (bitmap-font-get 'image current-bitmap-font)
|
||||
offset-x
|
||||
y
|
||||
(bitmap-font-get 'character-draw-width current-bitmap-font)
|
||||
(bitmap-font-get 'character-draw-height current-bitmap-font)
|
||||
(bitmap-char-x bitmap-char)
|
||||
(bitmap-char-y bitmap-char)
|
||||
(bitmap-font-get 'character-width current-bitmap-font)
|
||||
(bitmap-font-get 'character-height current-bitmap-font))
|
||||
(set! offset-x (+ offset-x (bitmap-font-get 'character-draw-width current-bitmap-font))))
|
||||
(make-bitmap-text text current-bitmap-font)))))
|
||||
|
||||
(define (draw-polygon points)
|
||||
(let* ((first-point #f)
|
||||
(previous-point #f))
|
||||
(for-each
|
||||
(lambda (point)
|
||||
(when (not first-point)
|
||||
(set! first-point point)
|
||||
(set! previous-point first-point))
|
||||
(draw-line (car previous-point)
|
||||
(cdr previous-point)
|
||||
(car point)
|
||||
(cdr point))
|
||||
(set! previous-point point))
|
||||
points)
|
||||
(when first-point
|
||||
(draw-line (car previous-point)
|
||||
(cdr previous-point)
|
||||
(car first-point)
|
||||
(cdr first-point)))))
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
(define-library
|
||||
(retropikzel spite)
|
||||
(import (scheme base)
|
||||
(scheme write)
|
||||
(scheme complex)
|
||||
(scheme process-context)
|
||||
(scheme file)
|
||||
(scheme load)
|
||||
(scheme time)
|
||||
(foreign c))
|
||||
(export spite-init
|
||||
spite-start
|
||||
spite-option-set!
|
||||
|
||||
load-image
|
||||
image?
|
||||
image-path
|
||||
|
||||
draw-image
|
||||
draw-image-slice
|
||||
|
||||
set-draw-color
|
||||
draw-point
|
||||
draw-line
|
||||
draw-rectangle
|
||||
fill-rectangle
|
||||
draw-circle
|
||||
draw-polygon
|
||||
|
||||
push-event
|
||||
clear-events!
|
||||
|
||||
make-bitmap-font
|
||||
set-bitmap-font
|
||||
draw-bitmap-text)
|
||||
(include "spite.scm"))
|
||||
|
|
@ -0,0 +1,202 @@
|
|||
Game library inspired by some other game library named after emotion built on
|
||||
top of [(foreign c)](https://sr.ht/~retropikzel/foreign-c/).
|
||||
|
||||
Please note that Spite is currently in **alpha** stage.
|
||||
|
||||
|
||||
[Issue tracker](https://todo.sr.ht/~retropikzel/Spite)
|
||||
|
||||
[Mailing lists](https://sr.ht/~retropikzel/Spite/lists)
|
||||
|
||||
[Source](https://git.sr.ht/~retropikzel/spite)
|
||||
|
||||
|
||||
## Documentation - Spite
|
||||
|
||||
|
||||
|
||||
(**spite-init** title width height)
|
||||
|
||||
This needs to be called first. title is a string you want to be used as
|
||||
the game window title. width and height are the desired window size.
|
||||
|
||||
It will initialize spite, loading SDL2 libraries and such and then opens a
|
||||
window for you.
|
||||
|
||||
The renderer size is set to same size as window size, you can change it with:
|
||||
|
||||
(spite-option-set! 'renderer-size width height)
|
||||
|
||||
|
||||
|
||||
(**spite-start** update-procedure draw-procedure)
|
||||
|
||||
Starts the update and draw loop. Needs to be called for anything to happen.
|
||||
|
||||
update-procedure is the procedure which is run in the main loop before the
|
||||
draw procedure. Where the logic happens. draw-procedure is where you should
|
||||
do all your drawing.
|
||||
|
||||
|
||||
|
||||
(**spite-option-set! name . value)
|
||||
|
||||
Sets different options of Spite. name is the name of option. value is the
|
||||
value or values of the option.
|
||||
|
||||
Options and possible values:
|
||||
|
||||
- allow-window-resizing
|
||||
- #t #f
|
||||
- renderer-size
|
||||
- Width and height
|
||||
|
||||
|
||||
|
||||
(**load-image** path)
|
||||
|
||||
Loads image from the path, supported filetypes are same as supported by
|
||||
SDLimage [https://wiki.libsdl.org/SDL2image/FrontPage](https://wiki.libsdl.org/SDL2image/FrontPage)
|
||||
|
||||
Returns an image record. Which can be used with draw-image and
|
||||
draw-image-slice.
|
||||
|
||||
|
||||
|
||||
(**image?** object)
|
||||
|
||||
Returns #t if object is image, otherwise #f.
|
||||
|
||||
|
||||
|
||||
(**draw-image** image-index x y width height)
|
||||
|
||||
Draws given image of image-index, returned by **load-image**. To position x
|
||||
and y, left top corner. Size of width and height.
|
||||
|
||||
|
||||
|
||||
(**draw-image-slice** image-index x y width height slize-x slice-y slice-width slice-height)
|
||||
|
||||
Draws given slice of image-index, returned by **load-image**. To position x
|
||||
and y, left top corner. Size of width and height. Clipped from slice-x
|
||||
and slice-y (top left corner) of size slice-width slice-height.
|
||||
|
||||
|
||||
|
||||
(**make-color** r g b . a)
|
||||
|
||||
Makes a color record of red(r) green(g) blue(b) and optionally of alpha(a).
|
||||
If a is not given it defaults to 255.
|
||||
|
||||
|
||||
|
||||
(**color?** object)
|
||||
|
||||
Returns #t of object is color, otherwise #f.
|
||||
|
||||
|
||||
|
||||
(**color:r** color)
|
||||
|
||||
Return red of color.
|
||||
|
||||
|
||||
|
||||
(**color:r!** color r)
|
||||
|
||||
Set the red of color
|
||||
|
||||
|
||||
|
||||
(**color:g** color)
|
||||
|
||||
Return green of color.
|
||||
|
||||
|
||||
|
||||
(**color:g!** color g)
|
||||
|
||||
Set the green of color
|
||||
|
||||
|
||||
|
||||
(**color:b** color)
|
||||
|
||||
Return blue of color.
|
||||
|
||||
|
||||
|
||||
(**color:b!** color b)
|
||||
|
||||
Set the blue of color
|
||||
|
||||
|
||||
|
||||
(**color:a** color)
|
||||
|
||||
Return alpha of color.
|
||||
|
||||
|
||||
|
||||
(**color:a!** color a)
|
||||
|
||||
Set the alpha of color
|
||||
|
||||
|
||||
|
||||
(**draw-point** x y size color)
|
||||
|
||||
Draws a point of size and color on x and y.
|
||||
|
||||
|
||||
|
||||
(**draw-line** x1 y1 x2 y2 line-size color)
|
||||
|
||||
Draws a line from point x1 y1 to x2 y2 with line-size of color.
|
||||
|
||||
|
||||
|
||||
(**make-event** type data)
|
||||
|
||||
Make new event with given type and data.
|
||||
|
||||
|
||||
|
||||
(**push-event** type data)
|
||||
|
||||
Make and push event of given type and data. The type should be a symbol, and
|
||||
data can be anything.
|
||||
|
||||
|
||||
|
||||
(**event:type** event)
|
||||
|
||||
Returns the type of the event.
|
||||
|
||||
|
||||
|
||||
(**event:data** event)
|
||||
|
||||
Returns the data of event.
|
||||
|
||||
|
||||
|
||||
(**clear-events!**)
|
||||
|
||||
Removes all events in the event queue.
|
||||
|
||||
|
||||
|
||||
(**make-bitmap-font** image character-width character-height draw-width draw-height characters)
|
||||
|
||||
|
||||
|
||||
(**draw-bitmap-text** text x y font)
|
||||
|
||||
|
||||
|
||||
(**draw-polygon** x y polygon)
|
||||
|
||||
Draw given polygon at position x y.
|
||||
|
||||
|
|
@ -0,0 +1,57 @@
|
|||
|
||||
(spite-init "Spite Test" 800 800)
|
||||
|
||||
(define player-x 100)
|
||||
(define player-y 100)
|
||||
|
||||
(define font-image (load-image "test-resources/charmap-cellphone_black.png"))
|
||||
|
||||
(define black '(0 0 0))
|
||||
(define blue '(0 0 255))
|
||||
|
||||
(define character-width 7)
|
||||
(define character-height 9)
|
||||
(define draw-width 14)
|
||||
(define draw-height 18)
|
||||
(define character-lines (list " !\"#¤%&/()*+,-./01"
|
||||
"23456789:;<=>?@ABC"
|
||||
"DEFGHIJKLMNOPQRSTU"
|
||||
"VWXYZ[\\]^_´abcdefg"
|
||||
"hijklmnopqrstuvwxy"
|
||||
"z{|}~"))
|
||||
(define font (make-bitmap-font font-image
|
||||
character-width
|
||||
character-height
|
||||
draw-width
|
||||
draw-height
|
||||
character-lines))
|
||||
(set-bitmap-font font)
|
||||
|
||||
(define update
|
||||
(lambda (delta-time events)
|
||||
(for-each
|
||||
(lambda (event)
|
||||
(when (symbol=? (cdr (assoc 'type event)) 'key-down)
|
||||
(let ((key (cdr (assoc 'key event))))
|
||||
(when (string=? key "W") (set! player-y (- player-y 5)))
|
||||
(when (string=? key "A") (set! player-x (- player-x 5)))
|
||||
(when (string=? key "S") (set! player-y (+ player-y 5)))
|
||||
(when (string=? key "D") (set! player-x (+ player-x 5)))
|
||||
)))
|
||||
events)
|
||||
#t))
|
||||
|
||||
(define draw
|
||||
(lambda ()
|
||||
(draw-bitmap-text "Cool beans!" 100 100)
|
||||
(apply set-draw-color black)
|
||||
(draw-line 50 50 100 100)
|
||||
(apply set-draw-color blue)
|
||||
(draw-line 150 150 200 200)
|
||||
(apply set-draw-color black)
|
||||
(draw-rectangle player-x player-y 64 64)
|
||||
(fill-rectangle (+ player-x 32) (+ player-y 32) 16 16)
|
||||
(draw-polygon '((300 . 332) (332 . 400) (432 . 400)))
|
||||
))
|
||||
|
||||
(spite-start update draw)
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 11 KiB |
Loading…
Reference in New Issue