Mercurial > dylan

comparison mtg/continuation.clj @ 2:b4de894a1e2e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
initial import
author Robert McIntyre <rlm@mit.edu>
date Fri, 28 Oct 2011 00:03:05 -0700
parents
children
comparison
equal deleted inserted replaced
1:8d8278e09888 2:b4de894a1e2e
1 (ns mtg.continuation)
2 ;; convention: cps function names end in &
3
4 (def not-nil? (comp not nil?))
5 (defn cpt "Continuation-passing transform. Makes f take a continuation as an additional argument."[f]
6 (fn[& args]
7 ((last args) (apply f (butlast args)))))
8
9
10
11 ;; Card operations
12
13
14 ;; Open predicates
15 ;(defmacro literal-to-keyword[x] `(keyword (quote ~x)))
16 (defrecord Oracle [])
17 (def *oracle* (atom (Oracle.)))
18
19 (defn ask* [m k](get @m k (cpt(constantly nil))))
20 (defn tell!* [m k v] (swap! m assoc k v))
21
22 (def ask(partial ask* *oracle*))
23 ;(def ? (fn [k & args] (apply (ask k) args)))
24
25 (def tell! (partial tell!* *oracle*))
26 (defn extend[k f] ((ask k) f))
27
28 ;; PRELIMINARY DEFINITIONS
29 (defmacro defq "Defines a query." [name params & body]
30 `(tell! (keyword ~name) (fn ~params ~@body)))
31 (defmacro ? "Asks a query." [name & args]
32 `((ask (keyword name)) ~@args))
33
34 (defn true-preds "Returns a sequence of the preds for which (pred obj) returns true."
35 [obj & preds]
36 (map (comp (partial apply str) rest butlast str)
37 (filter #(? % obj) preds)))
38
39 (tell! :the-players #{})
40 (tell! :player? (fn[obj & _] (not-nil? (? the-players obj))))
41
42
43
44
45
46
47
48 (defq object? [obj & _] ;; 109.1
49 ((comp not empty?)(true-preds obj :card? :copied-card? :token? :spell? :permanent? :emblem?)))
50
51 (defq has-controller? [obj & _]
52 (if (and (not (? in-zone 'battlefield obj))
53 (not (? on-stack obj))) false))
54
55 (defq take-turn [player & _] nil)
56
57
58 (tell! :characteristics (fn[obj & _]
59 (list :name :mana-cost :color :card-type :subtype :supertype :expansion-symbol :rules-text :abilities :power :toughness :loyalty :hand-modifier :life-modifier)))
60
61
62
63
64 (tell! :colors
65 (fn[obj & _]
66 (true-preds obj :red? :blue? :green? :white? :black?)))
67
68
69
70
71
72
73 ;; GAME / TURN MECHANICS
74 (defn new-game "Start a new two-player game."[]
75 (tell! :the-players #{'PLAYERONE 'PLAYERTWO})
76 (tell! :life-total (reduce #(assoc %1 (keyword %2) 20) {} (ask :the-players) ))
77 )
78
79
80
81 ;;(ask :blue) blue? = (fn[& args](fn[k] (k ...) ))
82 ;; (cpt (constantly nil))
83 ;;(ask k) = (get self k (cpt(constantly nil)))
84
85
86
87
88
89
90 (defn reverse&[coll k]
91 (if (empty? coll) (k '())
92 (recur (rest coll) (fn[x](k (conj x (first coll))))
93
94 )))
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111 (defn choose "Asks player to choose a member of the universe which matches all the given predicate; returns the chosen member." [player & preds]
112
113 )
114
115
116 (defn get* "Returns the value of key for the object, default or nil if key is not present."
117 ([obj key])
118 ([obj key default]))
119
120
121
122
123
124
125
126
127
128
129
130
131
132 ;; shuffle decks
133 ;; anyone may cut anyone else's deck
134 ;; deck => library
135 ;; decide who goes first
136 ;; players decide whether to mulligan in APNAP
137 ;; players mulligan simultaneously
138 ;; ... finish mulligans
139 ;; opening hand abilities
140 ;; beginning game abilities
141 ;; 2P game: first player skips draw phase of first turn
142
143 ;; pooled mana: produced-by, spendable-on
144
145
146
147
148 ;; VALUES WITH MODIFICATION HISTORY
149 ;(deftype trace[subject ])
150
151 ;(defn trace [x]{:subject x :modifiers '()})
152 ;(defn modifiers[tr] (get :modifiers tr '()))
153 ;(defn subject[tr] (:subject tr))
154
155 ;(defn modify[tr f](assoc tr :modifiers (conj (modifiers tr) f)))
156 ;(defn compute[tr] (:modifiers tr))
157
158 ;; players
159