1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/mtg/continuation.clj	Fri Oct 28 00:03:05 2011 -0700
     1.3 @@ -0,0 +1,159 @@
     1.4 +(ns mtg.continuation)
     1.5 +;; convention: cps function names end in &
     1.6 +
     1.7 +(def not-nil? (comp not nil?))
     1.8 +(defn cpt "Continuation-passing transform. Makes f take a continuation as an additional argument."[f]
     1.9 +  (fn[& args]
    1.10 +    ((last args) (apply f (butlast args)))))
    1.11 +
    1.12 +
    1.13 +
    1.14 +;; Card operations
    1.15 +
    1.16 +
    1.17 +;; Open predicates
    1.18 +					;(defmacro literal-to-keyword[x] `(keyword (quote ~x)))
    1.19 +(defrecord Oracle [])
    1.20 +(def *oracle* (atom (Oracle.)))
    1.21 +
    1.22 +(defn ask* [m k](get @m k (cpt(constantly nil))))
    1.23 +(defn tell!* [m k v] (swap! m assoc k v))
    1.24 +
    1.25 +(def ask(partial ask* *oracle*))
    1.26 +;(def ? (fn [k & args] (apply (ask k) args)))
    1.27 +     
    1.28 +(def tell! (partial tell!* *oracle*))
    1.29 +(defn extend[k f] ((ask k) f))
    1.30 +
    1.31 +;; PRELIMINARY DEFINITIONS
    1.32 +(defmacro defq "Defines a query." [name params & body]
    1.33 +  `(tell! (keyword ~name) (fn ~params ~@body)))
    1.34 +(defmacro ? "Asks a query." [name & args]
    1.35 +  `((ask (keyword name)) ~@args))  
    1.36 +
    1.37 +(defn true-preds "Returns a sequence of the preds for which (pred obj) returns true."
    1.38 +  [obj & preds]
    1.39 +  (map (comp (partial apply str) rest butlast str)
    1.40 +       (filter #(? % obj) preds)))
    1.41 +
    1.42 +(tell! :the-players #{})
    1.43 +(tell! :player? (fn[obj & _] (not-nil? (? the-players obj)))) 
    1.44 +
    1.45 +
    1.46 +
    1.47 +
    1.48 +
    1.49 +
    1.50 +
    1.51 +(defq object? [obj & _] ;; 109.1
    1.52 +  ((comp not empty?)(true-preds obj :card? :copied-card? :token? :spell? :permanent? :emblem?)))
    1.53 +
    1.54 +(defq has-controller? [obj & _]
    1.55 +  (if (and (not (? in-zone 'battlefield obj))
    1.56 +	   (not (? on-stack obj))) false))
    1.57 +
    1.58 +(defq take-turn [player & _] nil)
    1.59 +
    1.60 +
    1.61 +(tell! :characteristics (fn[obj & _]
    1.62 +			  (list :name :mana-cost :color :card-type :subtype :supertype :expansion-symbol :rules-text :abilities :power :toughness :loyalty :hand-modifier :life-modifier)))
    1.63 +
    1.64 +
    1.65 +	      
    1.66 +
    1.67 +(tell! :colors
    1.68 +       (fn[obj & _]
    1.69 +	 (true-preds obj :red? :blue? :green? :white? :black?)))
    1.70 +
    1.71 +
    1.72 +
    1.73 +
    1.74 +
    1.75 +
    1.76 +;; GAME / TURN MECHANICS
    1.77 +(defn new-game "Start a new two-player game."[]
    1.78 +  (tell! :the-players #{'PLAYERONE 'PLAYERTWO})
    1.79 +  (tell! :life-total (reduce #(assoc %1 (keyword %2) 20) {} (ask :the-players) ))
    1.80 +)
    1.81 +
    1.82 +
    1.83 +
    1.84 +;;(ask :blue) blue? = (fn[& args](fn[k] (k  ...) ))
    1.85 +;;            (cpt (constantly nil))
    1.86 +;;(ask k) = (get self k (cpt(constantly nil))) 
    1.87 +
    1.88 +
    1.89 +
    1.90 +
    1.91 +
    1.92 +
    1.93 +(defn reverse&[coll k]
    1.94 +  (if (empty? coll) (k '())
    1.95 +      (recur (rest coll) (fn[x](k (conj x (first coll))))
    1.96 +
    1.97 +      )))
    1.98 +					    
    1.99 +
   1.100 +
   1.101 +
   1.102 +
   1.103 +
   1.104 +
   1.105 +
   1.106 +
   1.107 +
   1.108 +
   1.109 +
   1.110 +
   1.111 +
   1.112 +
   1.113 +
   1.114 +(defn choose "Asks player to choose a member of the universe which matches all the given predicate; returns the chosen member." [player & preds]
   1.115 +  
   1.116 +  )
   1.117 +
   1.118 +
   1.119 +(defn get* "Returns the value of key for the object, default or nil if key is not present." 
   1.120 +  ([obj key])
   1.121 +  ([obj key default]))
   1.122 +
   1.123 +
   1.124 +
   1.125 +
   1.126 +
   1.127 +
   1.128 +
   1.129 +
   1.130 +
   1.131 +
   1.132 +
   1.133 +
   1.134 +
   1.135 +;; shuffle decks
   1.136 +;; anyone may cut anyone else's deck
   1.137 +;; deck => library
   1.138 +;; decide who goes first
   1.139 +;; players decide whether to mulligan in APNAP
   1.140 +;; players mulligan simultaneously
   1.141 +;; ... finish mulligans
   1.142 +;; opening hand abilities
   1.143 +;; beginning game abilities
   1.144 +;; 2P game: first player skips draw phase of first turn
   1.145 +
   1.146 +;; pooled mana: produced-by, spendable-on
   1.147 +
   1.148 +
   1.149 +
   1.150 +
   1.151 +;; VALUES WITH MODIFICATION HISTORY
   1.152 +;(deftype trace[subject ])
   1.153 +
   1.154 +;(defn trace [x]{:subject x :modifiers '()})
   1.155 +;(defn modifiers[tr] (get :modifiers tr '()))
   1.156 +;(defn subject[tr] (:subject tr)) 
   1.157 +
   1.158 +;(defn modify[tr f](assoc tr :modifiers (conj (modifiers tr) f)))
   1.159 +;(defn compute[tr]  (:modifiers tr))
   1.160 +
   1.161 +;; players
   1.162 +