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

Main menu for tic-tac-toe and text/rectangle drawing functions

Browse source
This commit is contained in:
BirDt_ 2026-04-19 21:58:13 +08:00
parent 6ec23c8ff9
commit 0544429d07
2 changed files with 225 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

57
engine/drawing.scm
View file

@ -189,6 +189,29 @@
(define set-triangle-2d-filled!
(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
(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!)
@ -200,13 +223,13 @@
(layer visual-2d-layer int:set-visual-2d-layer!))
(define (make-visual-2d draw color layer)
(assert ((disjoin triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?) draw))
(assert ((disjoin text-2d? triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?) draw))
(assert (color? color))
(assert (integer? layer))
(int:make-visual-2d draw color layer))
(define set-visual-2d-draw!
(guarded-mutator visual-2d? 'draw (disjoin triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?)))
(guarded-mutator visual-2d? 'draw (disjoin text-2d? triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?)))
(define set-visual-2d-color!
(guarded-mutator visual-2d? 'color color?))
(define set-visual-2d-layer!
@ -214,7 +237,7 @@
;; Drawing functions
;; Helper wrappers for raylib functions
(export draw-circle-2d)
(export draw-circle-2d draw-rectangle-2d draw-text-2d)
(define (draw-circle-2d pos-vec radius color filled)
(assert (vec2? pos-vec))
(assert (number? radius))
@ -222,9 +245,35 @@
(assert (boolean? filled))
((if filled
draw-circle
draw-circle-2d)
draw-circle-lines)
(number->integer (v-x pos-vec))
(number->integer (v-y pos-vec))
(number->integer radius)
(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)))
)

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

@ -0,0 +1,172 @@
(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)
)