Mercurial > dylan

     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
author	Robert McIntyre <rlm@mit.edu>
date	Fri, 28 Oct 2011 00:03:05 -0700
parents
children