rlm@2: (ns mtg.continuation)
rlm@2: ;; convention: cps function names end in &
rlm@2: 
rlm@2: (def not-nil? (comp not nil?))
rlm@2: (defn cpt "Continuation-passing transform. Makes f take a continuation as an additional argument."[f]
rlm@2:   (fn[& args]
rlm@2:     ((last args) (apply f (butlast args)))))
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: ;; Card operations
rlm@2: 
rlm@2: 
rlm@2: ;; Open predicates
rlm@2: 					;(defmacro literal-to-keyword[x] `(keyword (quote ~x)))
rlm@2: (defrecord Oracle [])
rlm@2: (def *oracle* (atom (Oracle.)))
rlm@2: 
rlm@2: (defn ask* [m k](get @m k (cpt(constantly nil))))
rlm@2: (defn tell!* [m k v] (swap! m assoc k v))
rlm@2: 
rlm@2: (def ask(partial ask* *oracle*))
rlm@2: ;(def ? (fn [k & args] (apply (ask k) args)))
rlm@2:      
rlm@2: (def tell! (partial tell!* *oracle*))
rlm@2: (defn extend[k f] ((ask k) f))
rlm@2: 
rlm@2: ;; PRELIMINARY DEFINITIONS
rlm@2: (defmacro defq "Defines a query." [name params & body]
rlm@2:   `(tell! (keyword ~name) (fn ~params ~@body)))
rlm@2: (defmacro ? "Asks a query." [name & args]
rlm@2:   `((ask (keyword name)) ~@args))  
rlm@2: 
rlm@2: (defn true-preds "Returns a sequence of the preds for which (pred obj) returns true."
rlm@2:   [obj & preds]
rlm@2:   (map (comp (partial apply str) rest butlast str)
rlm@2:        (filter #(? % obj) preds)))
rlm@2: 
rlm@2: (tell! :the-players #{})
rlm@2: (tell! :player? (fn[obj & _] (not-nil? (? the-players obj)))) 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: (defq object? [obj & _] ;; 109.1
rlm@2:   ((comp not empty?)(true-preds obj :card? :copied-card? :token? :spell? :permanent? :emblem?)))
rlm@2: 
rlm@2: (defq has-controller? [obj & _]
rlm@2:   (if (and (not (? in-zone 'battlefield obj))
rlm@2: 	   (not (? on-stack obj))) false))
rlm@2: 
rlm@2: (defq take-turn [player & _] nil)
rlm@2: 
rlm@2: 
rlm@2: (tell! :characteristics (fn[obj & _]
rlm@2: 			  (list :name :mana-cost :color :card-type :subtype :supertype :expansion-symbol :rules-text :abilities :power :toughness :loyalty :hand-modifier :life-modifier)))
rlm@2: 
rlm@2: 
rlm@2: 	      
rlm@2: 
rlm@2: (tell! :colors
rlm@2:        (fn[obj & _]
rlm@2: 	 (true-preds obj :red? :blue? :green? :white? :black?)))
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: ;; GAME / TURN MECHANICS
rlm@2: (defn new-game "Start a new two-player game."[]
rlm@2:   (tell! :the-players #{'PLAYERONE 'PLAYERTWO})
rlm@2:   (tell! :life-total (reduce #(assoc %1 (keyword %2) 20) {} (ask :the-players) ))
rlm@2: )
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: ;;(ask :blue) blue? = (fn[& args](fn[k] (k  ...) ))
rlm@2: ;;            (cpt (constantly nil))
rlm@2: ;;(ask k) = (get self k (cpt(constantly nil))) 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: (defn reverse&[coll k]
rlm@2:   (if (empty? coll) (k '())
rlm@2:       (recur (rest coll) (fn[x](k (conj x (first coll))))
rlm@2: 
rlm@2:       )))
rlm@2: 					    
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: (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:   
rlm@2:   )
rlm@2: 
rlm@2: 
rlm@2: (defn get* "Returns the value of key for the object, default or nil if key is not present." 
rlm@2:   ([obj key])
rlm@2:   ([obj key default]))
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: ;; shuffle decks
rlm@2: ;; anyone may cut anyone else's deck
rlm@2: ;; deck => library
rlm@2: ;; decide who goes first
rlm@2: ;; players decide whether to mulligan in APNAP
rlm@2: ;; players mulligan simultaneously
rlm@2: ;; ... finish mulligans
rlm@2: ;; opening hand abilities
rlm@2: ;; beginning game abilities
rlm@2: ;; 2P game: first player skips draw phase of first turn
rlm@2: 
rlm@2: ;; pooled mana: produced-by, spendable-on
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: 
rlm@2: ;; VALUES WITH MODIFICATION HISTORY
rlm@2: ;(deftype trace[subject ])
rlm@2: 
rlm@2: ;(defn trace [x]{:subject x :modifiers '()})
rlm@2: ;(defn modifiers[tr] (get :modifiers tr '()))
rlm@2: ;(defn subject[tr] (:subject tr)) 
rlm@2: 
rlm@2: ;(defn modify[tr f](assoc tr :modifiers (conj (modifiers tr) f)))
rlm@2: ;(defn compute[tr]  (:modifiers tr))
rlm@2: 
rlm@2: ;; players
rlm@2: