Mercurial > vba-clojure

     1 (ns com.aurellem.gb.items

     2   (:use (com.aurellem.gb gb-driver util))

     3   (:import [com.aurellem.gb.gb_driver SaveState]))

     4 

     5 (defn game-name

     6   "return pokemon-yellow header information"

     7   []

     8   (map char (subvec (vec (memory)) 0x134 0x142)))

     9 

    10 (def item-list-start 0xD31C)

    11 (def pc-item-list-start 0xD539)

    12 (def pc-item-list-width 101)

    13 

    14 

    15 (defn item-list

    16   ([^SaveState state]

    17      (subvec

    18       (vec (memory state))

    19       item-list-start

    20       (+ item-list-start 255)))

    21   ([] (item-list @current-state)))

    22 

    23 (defn nth-item

    24   ([^SaveState state n]

    25      (let [mem (memory state)]

    26        [(aget mem (+ item-list-start 1 (* 2 n)))

    27         (aget mem (+ item-list-start 2 (* 2 n)))]))

    28   ([n] (nth-item @current-state n)))

    29 

    30 

    31 (defn nth-pc-item

    32   ([^SaveState state n]

    33      (let [mem (memory state)]

    34        [(aget mem (+ pc-item-list-start 1 (* 2 n)))

    35         (aget mem (+ pc-item-list-start 2 (* 2 n)))]))

    36   ([n] (nth-pc-item @current-state n)))

    37 

    38 

    39 (def item-code->item-name

    40   (hash-map

    41    0x01 :master-ball       

    42    0x02 :ultra-ball

    43    0x03 :great-ball

    44    0x04 :poke-ball

    45    0x05 :town-map

    46    0x06 :bicycle

    47    0x07 :surfboard

    48    0x08 :safari-ball

    49    0x09 :pokedex

    50    0x0A :moon-stone

    51    0x0B :antidote

    52    0x0C :burn-heal

    53    0x0D :ice-heal

    54    0x0E :awakening

    55    0x0F :parlyz-heal

    56    0x10 :full-restore

    57    0x11 :max-potion

    58    0x12 :hyper-potion

    59    0x13 :super-potion

    60    0x14 :potion

    61    0x15 :boulderbadge

    62    0x16 :cascadebadge

    63    0x17 :thunderbadge

    64    0x18 :rainbowbadge

    65    0x19 :soulbadge

    66    0x1A :marshbadge

    67    0x1B :volcanobadge

    68    0x1C :earthbadge

    69    0x1D :escape-rope

    70    0x1E :repel

    71    0x1F :old-amber

    72    0x20 :fire-stone

    73    0x21 :thunderstone

    74    0x22 :water-stone

    75    0x23 :hp-up

    76    0x24 :protein

    77    0x25 :iron

    78    0x26 :carbos

    79    0x27 :calcium

    80    0x28 :rare-candy

    81    0x29 :dome-fossil

    82    0x2A :helix-fossil

    83    0x2B :secret-key

    84    0x2D :bike-voucher

    85    0x2E :x-accuracy

    86    0x2F :leaf-stone

    87    0x30 :card-key

    88    0x31 :nugget

    89    0x32 :pp-up-glitched

    90    0x33 :poke-doll

    91    0x34 :full-heal

    92    0x35 :revive

    93    0x36 :max-revive

    94    0x37 :guard-spec

    95    0x38 :super-repel

    96    0x39 :max-repel

    97    0x3A :dire-hit

    98    0x3B :coin

    99    0x3C :fresh-water

   100    0x3D :soda-pop

   101    0x3E :lemonade

   102    0x3F :s.s.ticket

   103    0x40 :gold-teeth

   104    0x41 :x-attack

   105    0x42 :x-defend

   106    0x43 :x-speed

   107    0x44 :x-special

   108    0x45 :coin-case

   109    0x46 :oaks-parcel

   110    0x47 :itemfinder

   111    0x48 :silph-scope

   112    0x49 :poke-flute

   113    0x4A :lift-key

   114    0x4B :exp.all

   115    0x4C :old-rod

   116    0x4D :good-rod

   117    0x4E :super-rod

   118    0x4F :pp-up

   119    0x50 :ether

   120    0x51 :max-ether

   121    0x52 :elixer

   122    0x53 :max-elixer

   123    0xC4 :HM01     ;; cut		   

   124    0xC5 :HM02     ;; fly		   

   125    0xC6 :HM03     ;; surf		   

   126    0xC7 :HM04     ;; strength	   

   127    0xC8 :HM05     ;; flash	   

   128    0xC9 :TM01     ;; mega punch	   

   129    0xCA :TM02     ;; razor wind	   

   130    0xCB :TM03     ;; swords dance	   

   131    0xCC :TM04     ;; whirlwind	   

   132    0xCD :TM05     ;; mega kick	   

   133    0xCE :TM06     ;; toxic	   

   134    0xCF :TM07     ;; horn drill	   

   135    0xD0 :TM08     ;; body slam	   

   136    0xD1 :TM09     ;; take down	   

   137    0xD2 :TM10     ;; double-edge	   

   138    0xD3 :TM11     ;; bubblebeam	   

   139    0xD4 :TM12     ;; water gun	   

   140    0xD5 :TM13     ;; ice beam 	   

   141    0xD6 :TM14     ;; blizzard	   

   142    0xD7 :TM15     ;; hyper beam	   

   143    0xD8 :TM16     ;; pay day	   

   144    0xD9 :TM17     ;; submission	   

   145    0xDA :TM18     ;; counter	   

   146    0xDB :TM19     ;; seismic toss	   

   147    0xDC :TM20     ;; rage		   

   148    0xDD :TM21     ;; mega drain	   

   149    0xDE :TM22     ;; solarbeam	   

   150    0xDF :TM23     ;; dragon rage	   

   151    0xE0 :TM24     ;; thunderbolt	   

   152    0xE1 :TM25     ;; thunder	   

   153    0xE2 :TM26     ;; earthquake	   

   154    0xE3 :TM27     ;; fissure	   

   155    0xE4 :TM28     ;; dig		   

   156    0xE5 :TM29     ;; psychic 	   

   157    0xE6 :TM30     ;; teleport	   

   158    0xE7 :TM31     ;; mimic	   

   159    0xE8 :TM32     ;; double team	   

   160    0xE9 :TM33     ;; reflect	   

   161    0xEA :TM34     ;; bide		   

   162    0xEB :TM35     ;; metronome	   

   163    0xEC :TM36     ;; self destruct   

   164    0xED :TM37     ;; egg bomb	   

   165    0xEE :TM38     ;; fire blast	   

   166    0xEF :TM39     ;; swift	   

   167    0xF0 :TM40     ;; skull bash	   

   168    0xF1 :TM41     ;; softboiled	   

   169    0xF2 :TM42     ;; dream eater	   

   170    0xF3 :TM43     ;; sky attack	   

   171    0xF4 :TM44     ;; rest		   

   172    0xF5 :TM45     ;; thunder wave	   

   173    0xF6 :TM46     ;; psywave	   

   174    0xF7 :TM47     ;; explosion	   

   175    0xF8 :TM48     ;; rock slide	   

   176    0xF9 :TM49     ;; tri attack	   

   177    0xFA :TM50     ;; substitute	   

   178    0xFB :TM51     ;; "cut"	   

   179    0xFC :TM52     ;; "fly"	   

   180    0xFD :TM53     ;; "surf"	   

   181    0xFE :TM54     ;; "strength"      

   182    0xFF :TM55     ;; "flash" (also end-of-list-sentinel)

   183    ))

   184 

   185 (def item-name->item-code

   186   (zipmap (vals item-code->item-name)

   187           (keys item-code->item-name)))

   188 

   189 (defn raw-inventory->inventory

   190   [raw-inventory]

   191   (map

   192      (fn [[item-code quantity]]

   193        [(item-code->item-name

   194          item-code

   195          item-code)

   196            quantity])

   197      (partition

   198       2

   199       raw-inventory)))

   200 

   201 (defn total-held-items [state]

   202   (aget (memory state) item-list-start))

   203 

   204 (defn inventory

   205   ([^SaveState state]

   206      (let [items (item-list state)]

   207        (raw-inventory->inventory

   208         (take (* 2 (total-held-items state)) (next items)))))

   209   ([] (inventory @current-state)))

   210 

   211 (defn print-inventory

   212   ([] (print-inventory @current-state))

   213   ([^SaveState state]

   214      (println

   215       (let [inv (inventory state)]

   216         (reduce

   217          str

   218          (concat

   219           ["+-------------------+----------+\n"

   220            "|##| Item           | Quantity |\n"

   221            "+--+----------------+----------+\n"]

   222 

   223           (map

   224            (fn [index [item-name quantity]]

   225              (str 

   226               (format "|%-2d| %-14s | %3d      |\n" index

   227                       (apply str (rest (str item-name)))

   228                       quantity)))

   229            (range 0 (count inv)) inv)

   230           ["+--+----------------+----------+\n"]))))

   231      state))

   232 

   233 (defn inventory-codes [inventory]

   234   (flatten

   235    (concat [(count inventory)]

   236            (map (fn [[item-name quantity]]

   237                   [(item-name->item-code item-name item-name)

   238                    quantity]) inventory)

   239            [(item-name->item-code :TM55)])))

   240 

   241 (defn set-inv-mem [^SaveState state inv-codes]

   242   (set-memory-range state item-list-start

   243                     inv-codes))

   244   

   245 

   246 (defn set-inventory [^SaveState state new-inventory]

   247   (set-inv-mem state (inventory-codes new-inventory)))

   248 

   249 (defn give-items

   250   ([^SaveState state items]

   251      (set-inventory state

   252                     (concat items (inventory state))))

   253   ([items]

   254      (give-items @current-state items)))

   255 

   256 (defn clear-inventory

   257   ([^SaveState state]

   258      (set-inventory state []))

   259   ([] (clear-inventory @current-state)))

   260 

   261
author	Dylan Holmes <ocsenave@gmail.com>
date	Thu, 12 Apr 2012 22:30:03 -0500
parents	79252378fd22
children	716752719a78