enfin un triangle

Makefile

@@ -0,0 +1,5 @@
+business-tycoon: src/business-tycoon.asd src/*.lisp
+	sbcl --load "src/business-tycoon.asd" \
+	     --eval "(ql:quickload :business-tycoon)" \
+	     --eval "(in-package :business-tycoon)" \
+	     --eval "(sb-ext:save-lisp-and-die #P\"$@\" :toplevel #'main :executable t)"

README.md

@@ -1,5 +1,5 @@
 # business-tycoon
-### Gabriel Pariat <gabriel@pariatech.com>_
+### Gabriel Pariat <gabriel@pariatech.com>
 
 Pariatech's Business Tycoon
 

business-tycoon.asd

@@ -6,6 +6,11 @@
   :license  "Specify license here"
   :version "0.0.1"
   :serial t
-  :depends-on (#:cl-glfw3 #:cl-opengl)
-  :components ((:file "package")
-               (:file "business-tycoon")))
+  :depends-on (#:cl-glfw3 #:cl-opengl #:trivial-main-thread #:cffi)
+  :components ((:module "src"
+		:serial t
+		:components ((:file "package")
+			     (:file "observable")
+			     (:file "renderer")
+			     (:file "window")
+			     (:file "business-tycoon")))))

src/business-tycoon.lisp

@@ -0,0 +1,6 @@
+;;;; business-tycoon.lisp
+
+(in-package #:business-tycoon)
+
+(defun main ()
+  (open-window :title "Pariatech's Business Tycoon"))

src/game-object.lisp

@@ -1,3 +1,3 @@
-;;;; business-tycoon.lisp
-
 (in-package #:business-tycoon)
+
+(defclass game-object ())

src/observable.lisp

@@ -0,0 +1,20 @@
+(defpackage #:observable
+  (:use #:cl)
+  (:export :observable :on :off :notify))
+
+(in-package :observable)
+
+(defclass observable ()
+  ((observers :accessor observers
+	      :initform (make-hash-table))))
+
+(defmethod on ((self observable) event f)
+  (push f (gethash event (observers self))))
+
+(defmethod off ((self observable) event f)
+  (setf (gethash event (observers self))
+	(remove f (gethash event (observers self)))))
+
+(defmethod notify ((self observable) event &optional value)
+  (loop for observer in (gethash event (observers self))
+	do (funcall observer value)))

src/renderer.lisp

@@ -0,0 +1,70 @@
+
+(in-package #:business-tycoon)
+
+(defparameter *vertex-shader-source* '("
+#version 330 core
+layout (location = 0) in vec3 aPos;
+
+void main()
+{
+    gl_Position = vec4(aPos.x, aPos.y, aPos.z, 1.0);
+}
+"))
+
+(defparameter *fragment-shader-source* '("
+#version 330 core
+out vec4 FragColor;
+
+void main()
+{
+    FragColor = vec4(1.0f, 0.5f, 0.2f, 1.0f);
+}
+"))
+
+
+(defparameter *vbo* 0)
+(defparameter *vao* 0)
+(defparameter *shader-program* 0)
+
+(defun init-renderer ()
+  (let ((vertex-shader (gl:create-shader :vertex-shader))
+	(fragment-shader (gl:create-shader :fragment-shader)))
+    (setf *shader-program* (gl:create-program))
+    (gl:shader-source vertex-shader *vertex-shader-source*)
+    (gl:compile-shader vertex-shader)
+    (gl:shader-source fragment-shader *fragment-shader-source*)
+    (gl:compile-shader fragment-shader)
+    (gl:attach-shader *shader-program* vertex-shader)
+    (gl:attach-shader *shader-program* fragment-shader)
+    (gl:link-program *shader-program*)
+    (gl:delete-shader vertex-shader)
+    (gl:delete-shader fragment-shader)
+    (setf *vbo* (gl:gen-buffer))
+    (setf *vao* (gl:gen-vertex-array))
+
+    (gl:bind-vertex-array *vao*)
+    (gl:bind-buffer :array-buffer *vbo*)
+
+    (let ((arr (gl:alloc-gl-array :float 12))
+	  (vertices #(-0.5 -0.5 0.0
+		       0.5 -0.5 0.0
+		       0.0  0.5 0.0)))
+      (dotimes (i (length vertices))
+	(setf (gl:glaref arr i) (aref vertices i)))
+      (gl:buffer-data :array-buffer :static-draw arr)
+      (gl:free-gl-array arr))
+
+    (gl:vertex-attrib-pointer 0 3 :float nil 0 (cffi:null-pointer))
+    (gl:enable-vertex-attrib-array 0)))
+
+(defun render ()
+  (gl:clear :color-buffer)
+  ;; (gl:with-pushed-matrix
+  ;;   (gl:color 1 1 1)
+  ;;   (gl:rect -25 -25 25 25))
+
+  (gl:use-program *shader-program*)
+  (gl:bind-vertex-array *vao*)
+  (gl:draw-arrays :triangles 0 3)
+
+  (glfw:swap-buffers))

src/state.lisp

@@ -0,0 +1,8 @@
+(in-package :business-tycoon)
+
+(defstruct state
+  keys-pressed)
+
+(defparameter *state* (make-behavior-subject (make-state)))
+
+(defun reducer ())

src/window.lisp

@@ -0,0 +1,48 @@
+(in-package #:business-tycoon)
+
+(defun set-viewport (width height)
+  (gl:viewport 0 0 width height)
+  (gl:matrix-mode :projection)
+  (gl:load-identity)
+  (gl:ortho -50 50 -50 50 -1 1)
+  (gl:matrix-mode :modelview)
+  (gl:load-identity))
+
+(defun get-key (key)
+  (glfw:get-key key))
+
+(defun close-window ()
+  (glfw:set-window-should-close))
+
+(glfw:def-key-callback key-callback (window key scancode action mod-keys)
+  (declare (ignore window scancode mod-keys))
+  (when (and (eq key :escape) (eq action :press))
+    (glfw:set-window-should-close)))
+
+(glfw:def-mouse-button-callback mouse-button-callback (window button action mod-keys)
+    (declare (ignore window button action mod-keys)))
+
+(glfw:def-window-size-callback update-viewport (window w h)
+    (declare (ignore window))
+    (set-viewport w h))
+
+(defun open-window (&key (title "") (width 800) (height 600))
+  ;; (tmt:with-body-in-main-thread ()
+    (glfw:with-init-window (:title title
+			    :width width
+			    :height height
+			    ;; :context-version-major 3
+			    ;; :context-version-minor 3
+			    ;; :opengl-profile :opengl-core-profile
+			    )
+      (setf %gl:*gl-get-proc-address* #'glfw:get-proc-address)
+      (glfw:set-key-callback 'key-callback)
+      (glfw:set-mouse-button-callback 'mouse-button-callback)
+      (glfw:set-window-size-callback 'update-viewport)
+      (gl:clear-color 0 0 0 0)
+      (set-viewport width height)
+      (init-renderer)
+      (loop until (glfw:window-should-close-p)
+	    do (render)
+	    do (glfw:poll-events))))
+;; )