Browse files

Integration with FLARE

  • Loading branch information...
Shinmera committed Apr 7, 2016
1 parent 0aa38e7 commit 6870b472c63d11172196d2e18918f982f163402a
Showing with 30 additions and 34 deletions.
  1. +3 −19 entity.lisp
  2. +1 −1 event-loop.lisp
  3. +19 −0 flare.lisp
  4. +1 −0 package.lisp
  5. +0 −9 scene.lisp
  6. +4 −4 subjects.lisp
  7. +2 −1 trial.asd
@@ -7,32 +7,16 @@
(in-package #:org.shirakumo.fraf.trial)
(defgeneric matches (a b))
(defgeneric draw (thing))
(defgeneric draw-hud (thing))
(defmethod matches (a b)
(equal a b))
(defclass entity ()
(defclass entity (unit)
(defmethod draw ((entity entity)))
(defmethod draw-hud ((entity entity)))
(defmethod matches ((a entity) b)
(eql a b))
(or (eql a b)
(matches (name a) b)))
(defmethod matches (a (b entity))
(matches b a))
(defclass named-entity (entity)
((name :initarg :name :reader name))
:name (error "NAME required.")))
(defmethod print-object ((entity named-entity) stream)
(print-unreadable-object (entity stream :type T)
(format stream "~s" (name entity))))
(defmethod matches ((a named-entity) b)
(matches (name a) b))
@@ -66,7 +66,7 @@
(dolist (handler (handlers loop))
(handle event handler))))
(defclass handler (named-entity)
(defclass handler (entity)
((event-type :initarg :event-type :accessor event-type)
(container :initarg :container :accessor container)
(delivery-function :initarg :delivery-function :accessor delivery-function)
@@ -0,0 +1,19 @@
This file is a part of trial
(c) 2016 Shirakumo (
Author: Nicolas Hafner <>
(in-package #:org.shirakumo.fraf.trial)
(in-readtable :qtools)
(defmethod finalize ((set flare-indexed-set:indexed-set))
(flare-indexed-set:map-set #'finalize set))
(defmethod finalize ((container container))
(finalize (objects container)))
(defmethod call-with-translation (func (target main) (vec vec))
(gl:translate (vx vec) (vy vec) (vz vec))
(funcall func)))
@@ -8,5 +8,6 @@
(defpackage #:trial
(:nicknames #:org.shirakumo.fraf.trial)
(:use #:cl+qt #:3d-vectors #:flare)
(:shadowing-import-from #:flare #:slot)
(:shadow #:scene #:entity))
(in-package #:trial)
@@ -14,12 +14,3 @@
(defmethod leave :after ((subject subject) (scene scene))
(remove-handler subject scene))
(defmethod finalize ((scene scene))
(mapc #'finalize (subjects scene)))
(defmethod draw ((scene scene))
(mapc #'draw (subjects scene)))
(defmethod draw-hud ((scene scene))
(mapc #'draw-hud (subjects scene)))
@@ -37,7 +37,7 @@
(defmethod (setf texture) ((null null) (subject textured-subject))
(setf (slot-value subject 'texture) NIL))
(defmethod draw :around ((obj textured-subject))
(defmethod paint :around ((obj textured-subject) target)
(when (texture obj)
@@ -53,7 +53,7 @@
:location (vec 0 0 0)))
(defmethod draw :around ((obj located-subject))
(defmethod paint :around ((obj located-subject) (target main))
(let ((location (location obj)))
(gl:translate (vx location) (vy location) (vz location))
@@ -66,7 +66,7 @@
:orientation (vec 1 0 0)
:up (vec 0 1 0)))
(defmethod draw :around ((obj oriented-subject))
(defmethod paint :around ((obj oriented-subject) (target main))
(let ((axis (vc (up obj) (orientation obj)))
(angle (acos (v. (up obj) (orientation obj)))))
@@ -95,5 +95,5 @@
(defmethod (setf mesh) ((null null) (subject mesh-subject))
(setf (slot-value subject 'mesh) NIL))
(defmethod draw ((subject mesh-subject))
(defmethod paint ((subject mesh-subject) (target main))
(wavefront-loader::draw (mesh subject)))
@@ -19,9 +19,10 @@
(:file "entity")
(:file "event-loop")
(:file "scene")
(:file "windowing")
(:file "flare")
(:file "subjects")
(:file "camera")
(:file "windowing")
(:file "input-tables")
(:file "input")
(:file "mapping")

0 comments on commit 6870b47

Please sign in to comment.