Mercurial > dylan

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