forked from Shirakumo/trial
-
Notifications
You must be signed in to change notification settings - Fork 0
/
asset.lisp
99 lines (79 loc) · 3.02 KB
/
asset.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
#|
This file is a part of trial
(c) 2017 Shirakumo http://tymoon.eu ([email protected])
Author: Nicolas Hafner <[email protected]>
|#
(in-package #:org.shirakumo.fraf.trial)
(defclass asset (resource)
((pool :initform NIL :accessor pool)
(name :initform NIL :accessor name)
(input :initarg :input :accessor input)))
(defmethod initialize-instance ((asset asset) &key pool name)
(check-type name symbol)
(setf (name asset) name)
(when pool
(setf (pool asset) (etypecase pool
(symbol (find-pool pool T))
(pool pool)))
(setf (asset pool name) asset))
(call-next-method))
(defmethod reinitialize-instance :after ((asset asset) &key)
(when (allocated-p asset)
(reload asset)))
(defmethod update-instance-for-different-class :around ((previous asset) (current asset) &key)
;; FIXME: Error recovery?
(cond ((allocated-p current)
(deallocate current)
(call-next-method)
(load current))
(T
(call-next-method))))
(defmethod print-object ((asset asset) stream)
(print-unreadable-object (asset stream :type T)
(format stream "~a/~a" (when (pool asset) (name (pool asset))) (name asset))))
(defgeneric load (asset))
(defgeneric reload (asset))
(defmethod reload ((asset asset))
(deallocate asset)
(load asset))
(defmethod load :around ((asset asset))
(unless (allocated-p asset)
(v:trace :trial.asset "Loading ~a/~a" (when (pool asset) (name (pool asset))) (name asset))
(call-next-method)))
(defmethod deallocate :around ((asset asset))
(when (allocated-p asset)
(v:trace :trial.asset "Deallocating ~a/~a" (when (pool asset) (name (pool asset))) (name asset))
(call-next-method)))
(defmethod coerce-asset-input ((asset asset) (input (eql T)))
(coerce-asset-input asset (input asset)))
(defmethod coerce-asset-input ((asset asset) thing)
thing)
(defmethod coerce-asset-input ((asset asset) (path pathname))
(if (pool asset)
(pool-path (pool asset) path)
path))
(defmethod coerce-asset-input ((asset asset) (list list))
(loop for item in list collect (coerce-asset-input asset item)))
(defmacro define-asset ((pool name) type input &rest options)
(check-type pool symbol)
(check-type name symbol)
(check-type type symbol)
`(let ((,name (asset ',pool ',name NIL)))
(cond ((and ,name (eql (type-of ,name) ',type))
(reinitialize-instance ,name ,@options :input ,input))
(,name
(change-class ,name ',type ,@options :input ,input))
(T
(make-instance ',type ,@options :input ,input :name ',name :pool ',pool)))))
(trivial-indent:define-indentation define-asset (4 6 4 &body))
(defclass gl-asset (asset gl-resource) ())
(defmethod load :around ((asset gl-asset))
(with-context (*context*)
(call-next-method)))
(defmethod deallocate :around ((asset gl-asset))
(with-context (*context*)
(call-next-method)))
(defmethod reload :around ((asset gl-asset))
(when *context*
(with-context (*context*)
(call-next-method))))