172 lines
3.4 KiB
Scheme
172 lines
3.4 KiB
Scheme
(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)
|
|
)
|