BirDt/imugi
1
0
Fork 0
Code Issues 14 Pull requests Projects 1 Wiki Activity Actions

Compare commits

base: BirDt:0544429d0708b67e7bffcecaa0b172589c77558a
Branches Tags
BirDt:master
BirDt:bugfix/color-truncation
BirDt:feature/resource-texture-drawing
BirDt:feature/usage-docs
BirDt:feature/egg
BirDt:feature/game-loader
BirDt:feature/collaboration-build-improvements
BirDt:feature/tic-tac-toe
..
compare: BirDt:f54f9c4b402edea4d319ac08ac23711432039fa2
Branches Tags
BirDt:bugfix/color-truncation
BirDt:master
BirDt:feature/resource-texture-drawing
BirDt:feature/usage-docs
BirDt:feature/egg
BirDt:feature/game-loader
BirDt:feature/collaboration-build-improvements
BirDt:feature/tic-tac-toe

No commits in common. "0544429d0708b67e7bffcecaa0b172589c77558a" and "f54f9c4b402edea4d319ac08ac23711432039fa2" have entirely different histories.
0544429d07 ... f54f9c4b40

5 changed files with 45 additions and 287 deletions
Download patch file Download diff file Expand all files Collapse all files

41
engine/core.scm
View file

@ -304,6 +304,8 @@
(hash-table-set! event-buses name (make-hash-table)) (hash-table-set! event-buses name (make-hash-table))
name))) name)))
(register-event-bus 'input)
;; Remove an event bus ;; Remove an event bus
(define (remove-event-bus name) (define (remove-event-bus name)
(assert (symbol? name)) (assert (symbol? name))
@ -366,6 +368,45 @@
event) event)
#f))) #f)))
;; Input actions alist
(define input-actions '())
;; Key-press type action
(define-record-type <key-press>
(make-key-press key)
key-press?
(key key-press-key))
;; Add a new action to the input actions alist
(export register-action push-actions)
(define (register-action name type . data)
(assert (symbol? name))
(assert (member type '(key-press)))
(set! input-actions
(cons (cons name
(apply (cond
((eqv? type 'key-press) make-key-press))
data))
input-actions)))
;; Default global system for simple input management
(define push-actions
(make-system
'push-actions
0
'global
'()
(lambda ()
(for-each
(lambda (action)
(cond
((key-press? (cdr action))
(when (key-pressed? (key-press-key (cdr action)))
(push-event 'input
(car action)
(cdr action))))))
input-actions))))
;; Render queue exports ;; Render queue exports
(export register-render-queue push-render-object evaluate-render-queue) (export register-render-queue push-render-object evaluate-render-queue)

57
engine/drawing.scm
View file

@ -189,29 +189,6 @@
(define set-triangle-2d-filled! (define set-triangle-2d-filled!
(guarded-mutator triangle-2d? 'filled boolean?)) (guarded-mutator triangle-2d? 'filled boolean?))
;; 2D text drawing
(export text-2d? make-text-2d text-2d-position set-text-2d-position!
text-2d-text set-text-2d-text! text-2d-size set-text-2d-size!)
(define-record-type <text-2d>
(int:make-text-2d position text size)
text-2d?
(position text-2d-position int:set-text-2d-position!)
(text text-2d-text int:set-text-2d-text!)
(size text-2d-size int:set-text-2d-size!))
(define (make-text-2d position text size)
(assert (vec2? position))
(assert (string? text))
(assert ((conjoin integer? positive?) size))
(int:make-text-2d position text size))
(define set-text-2d-position!
(guarded-mutator text-2d? 'position vec2?))
(define set-text-2d-text!
(guarded-mutator text-2d? 'text string?))
(define set-text-2d-size!
(guarded-mutator text-2d? 'size (conjoin integer? positive?)))
;; Visual component ;; Visual component
(export visual-2d? make-visual-2d visual-2d-draw set-visual-2d-draw! (export visual-2d? make-visual-2d visual-2d-draw set-visual-2d-draw!
visual-2d-color set-visual-2d-color! visual-2d-layer set-visual-2d-layer!) visual-2d-color set-visual-2d-color! visual-2d-layer set-visual-2d-layer!)
@ -223,13 +200,13 @@
(layer visual-2d-layer int:set-visual-2d-layer!)) (layer visual-2d-layer int:set-visual-2d-layer!))
(define (make-visual-2d draw color layer) (define (make-visual-2d draw color layer)
(assert ((disjoin text-2d? triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?) draw)) (assert ((disjoin triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?) draw))
(assert (color? color)) (assert (color? color))
(assert (integer? layer)) (assert (integer? layer))
(int:make-visual-2d draw color layer)) (int:make-visual-2d draw color layer))
(define set-visual-2d-draw! (define set-visual-2d-draw!
(guarded-mutator visual-2d? 'draw (disjoin text-2d? triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?))) (guarded-mutator visual-2d? 'draw (disjoin triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?)))
(define set-visual-2d-color! (define set-visual-2d-color!
(guarded-mutator visual-2d? 'color color?)) (guarded-mutator visual-2d? 'color color?))
(define set-visual-2d-layer! (define set-visual-2d-layer!
@ -237,7 +214,7 @@
;; Drawing functions ;; Drawing functions
;; Helper wrappers for raylib functions ;; Helper wrappers for raylib functions
(export draw-circle-2d draw-rectangle-2d draw-text-2d) (export draw-circle-2d)
(define (draw-circle-2d pos-vec radius color filled) (define (draw-circle-2d pos-vec radius color filled)
(assert (vec2? pos-vec)) (assert (vec2? pos-vec))
(assert (number? radius)) (assert (number? radius))
@ -245,35 +222,9 @@
(assert (boolean? filled)) (assert (boolean? filled))
((if filled ((if filled
draw-circle draw-circle
draw-circle-lines) draw-circle-2d)
(number->integer (v-x pos-vec)) (number->integer (v-x pos-vec))
(number->integer (v-y pos-vec)) (number->integer (v-y pos-vec))
(number->integer radius) (number->integer radius)
(use-color color))) (use-color color)))
(define (draw-rectangle-2d pos-vec width height color filled thickness)
(assert (vec2? pos-vec))
(assert ((conjoin integer? positive?) width))
(assert ((conjoin integer? positive?) height))
(assert ((conjoin integer? positive?) thickness))
(assert (boolean? filled))
(assert (color? color))
(when filled
(draw-rectangle
(number->integer (v-x pos-vec))
(number->integer (v-y pos-vec))
width
height
(use-color color))))
(define (draw-text-2d pos-vec text size tint)
(assert (vec2? pos-vec))
(assert (string? text))
(assert ((conjoin integer? positive?) size))
(assert (color? tint))
(draw-text text
(number->integer (v-x pos-vec))
(number->integer (v-y pos-vec))
size
(use-color tint)))
) )

61
engine/input.scm
View file

@ -1,61 +0,0 @@
(module (engine input) ()
(import scheme
(chicken base)
(chicken module)
(engine core)
raylib
(srfi 99))
(register-event-bus 'input)
;; Input actions alist
(define input-actions '())
;; Key-press type action
(define-record-type <key-press>
(make-key-press key)
key-press?
(key key-press-key))
;; Mouse click type action
(define-record-type <mouse-press>
(make-mouse-press button)
mouse-press?
(button mouse-press-button))
;; Add a new action to the input actions alist
(export register-action push-actions)
(define (register-action name type . data)
(assert (symbol? name))
(assert (member type '(key-press mouse-press)))
(set! input-actions
(cons (cons name
(apply (cond
((eqv? type 'key-press) make-key-press)
((eqv? type 'mouse-press) make-mouse-press))
data))
input-actions)))
;; Default global system for simple input management
(define push-actions
(make-system
'push-actions
0
'global
'()
(lambda ()
(for-each
(lambda (action)
(cond
((key-press? (cdr action))
(when (key-pressed? (key-press-key (cdr action)))
(push-event 'input
(car action)
(cdr action))))
((mouse-press? (cdr action))
(when (mouse-button-pressed? (mouse-press-button (cdr action)))
(push-event 'input
(car action)
(cdr action))))))
input-actions))))
)

1
samples/bounce.scm
View file

@ -5,7 +5,6 @@
(engine core) (engine core)
(engine components core) (engine components core)
(engine math) (engine math)
(engine input)
(engine drawing) (engine drawing)
(engine scene) (engine scene)
(srfi 1) (srfi 1)

172
samples/tic-tac-toe.scm
View file

@ -1,172 +0,0 @@
(module (tic-tac-toe) ()
(import scheme
(chicken base)
(engine core)
(engine math)
(engine components core)
(engine drawing)
(engine input)
(engine scene)
raylib
(srfi 1)
(srfi 99))
(define draw-text-entities
(make-system
'draw-text
0
'entity
'(<visual-2d> <screen-transform>)
(lambda (_ vis-2d transform)
(let ((draw (visual-2d-draw vis-2d)))
(when (text-2d? draw)
(push-render-object 'screen
(visual-2d-layer vis-2d)
(lambda ()
(let ((draw-pos (v+ (position transform)
(text-2d-position draw))))
(draw-text-2d
draw-pos
(text-2d-text draw)
(text-2d-size draw)
(visual-2d-color vis-2d))))))))))
(define draw-rectangles
(make-system
'draw-rectangles
0
'entity
'(<visual-2d> <screen-transform>)
(lambda (_ vis-2d transform)
(let ((draw (visual-2d-draw vis-2d)))
(when (rectangle-2d? draw)
(push-render-object 'screen
(visual-2d-layer vis-2d)
(lambda ()
(let ((draw-pos (v+ (position transform)
(rectangle-2d-origin draw))))
(draw-rectangle-2d
draw-pos
(rectangle-2d-width draw)
(rectangle-2d-height draw)
(visual-2d-color vis-2d)
(rectangle-2d-filled? draw)
(rectangle-2d-thickness draw))))))))))
(register-action 'click 'mouse-press MOUSE_BUTTON_LEFT)
(define-record-type <button-region>
(make-button-region top-left bottom-right on-click)
button-region?
(top-left button-top-left)
(bottom-right button-bottom-right)
(on-click button-on-click))
(define click-buttons
(make-system
'click-buttons
1
'batch
'(<button-region> <screen-transform>)
(lambda (buttons)
(when (pop-event 'input 'click)
(for-each
(lambda (button)
(let* ((btn (find button-region? button))
(transform (find screen-transform? button))
(top-left (v+ (position transform)
(button-top-left btn)))
(bottom-right (v+ (position transform)
(button-bottom-right btn)))
(m-x (get-mouse-x))
(m-y (get-mouse-y)))
(when (and (< (v-x top-left) m-x (v-x bottom-right))
(< (v-y top-left) m-y (v-y bottom-right)))
((button-on-click btn)))))
buttons)))))
(define (game)
(scene
draw-text-entities
(entity
(make-screen-transform
(vec 350 250)
(vec 0 0)
0
(vec 1 1)
'center
'())
(make-visual-2d
(make-text-2d
(vec 0 0)
"You lost the game!"
12)
(make-color 0 0 0 1)
0))))
(define (main-menu)
(scene
draw-text-entities
click-buttons
draw-rectangles
push-actions
(entity
(make-screen-transform
(vec 350 250)
(vec 0 0)
0
(vec 1 1)
'center
'())
(make-visual-2d
(make-text-2d
(vec 0 0)
"Start Game!"
12)
(make-color 0 0 0 1)
0))
(entity
(make-button-region
(vec 0 0)
(vec 100 80)
(lambda ()
((game))))
(make-visual-2d
(make-rectangle-2d
(vec 0 0)
100
80
#t
1)
(make-color 1 0 0 1)
0)
(make-screen-transform
(vec 350 250)
(vec 0 0)
0
(vec 1 1)
'center
'()))
(entity
(make-visual-2d
(make-text-2d
(vec 0 0)
"Tic Tac Toe!"
48)
(make-color 0 0 0 1)
0)
(make-screen-transform
(vec 250 150)
(vec 0 0)
0
(vec 1 1)
'center
'()))))
((main-menu))
(create-window)
)