Mercurial > vba-clojure

comparison clojure/com/aurellem/gb/hxc.clj @ 282:0c3fbb313e49

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
added price data. also, shop data seems a bit off.
author Dylan Holmes <ocsenave@gmail.com>
date Wed, 28 Mar 2012 03:28:36 -0500
parents ca1afcef3542
children 516acb83410f
comparison
equal deleted inserted replaced
281:ca1afcef3542 282:0c3fbb313e49
21 replacing spaces with hyphens and converting to lowercase." 21 replacing spaces with hyphens and converting to lowercase."
22 [s] 22 [s]
23 (keyword (.toLowerCase 23 (keyword (.toLowerCase
24 (apply str 24 (apply str
25 (map #(if (= % \space) "-" %) s))))) 25 (map #(if (= % \space) "-" %) s)))))
26
27
28 ;; used to decode item prices
29
30 (defn decode-bcd
31 "Take a sequence of binary-coded digits (in written order) and return the number they represent."
32 [digits]
33 ((fn self [coll]
34 (if (empty? coll) 0
35 (+ (first coll) (* 100 (self (rest coll))))))
36 (map
37 #(+ (* 10 (int (/ % 16)))
38 (rem % 16))
39 (reverse digits))))
40
26 41
27 42
28 43
29 (def pkmn-types 44 (def pkmn-types
30 [:normal ;;0 45 [:normal ;;0
651 666
652 (partition entry-size 667 (partition entry-size
653 (take (* entry-size pkmn-count) 668 (take (* entry-size pkmn-count)
654 (drop 0x383DE 669 (drop 0x383DE
655 rom))))))) 670 rom)))))))
671
672
673
674 (defn hxc-item-prices
675 "The hardcoded list of item prices in memory. List begins at ROM@4495"
676 ([] (hxc-item-prices com.aurellem.gb.gb-driver/original-rom))
677 ([rom]
678 (let [items (map format-name (hxc-items rom))
679 price-size 3]
680 (zipmap items
681 (map (comp
682 ;; zero-cost items are "priceless"
683 #(if (zero? %) :priceless %)
684 decode-bcd butlast)
685 (partition price-size
686 (take (* price-size (count items))
687 (drop 0x4495 rom))))))))
656 688
657 (defn hxc-shops 689 (defn hxc-shops
658 ([] (hxc-shops com.aurellem.gb.gb-driver/original-rom)) 690 ([] (hxc-shops com.aurellem.gb.gb-driver/original-rom))
659 ([rom] 691 ([rom]
660 (let [items (zipmap (range) (map format-name (hxc-items rom))) 692 (let [items (zipmap (range) (map format-name (hxc-items rom)))
666 (comp keyword 698 (comp keyword
667 (partial str "tm-") 699 (partial str "tm-")
668 (partial + 1 -200) 700 (partial + 1 -200)
669 )) 701 ))
670 (take 200 (drop 200 (range))))) 702 (take 200 (drop 200 (range)))))
671 703
672 ] 704 ]
673 705
674 ((fn parse-shop [coll [num-items & items-etc]] 706 ((fn parse-shop [coll [num-items & items-etc]]
675 (let [inventory (take (dec num-items) (rest items-etc)) 707 (let [inventory (take-while
708 (partial not= 0xFF)
709 items-etc)
676 [separator & items-etc] (drop num-items (rest items-etc))] 710 [separator & items-etc] (drop num-items (rest items-etc))]
677 (if (= separator 0x50) 711 (if (= separator 0x50)
678 (map (partial mapv (comp items dec)) (conj coll inventory)) 712 (map (partial mapv (comp items dec)) (conj coll inventory))
679 (recur (conj coll inventory) items-etc) 713 (recur (conj coll inventory) items-etc)
680 ) 714 )
681 )) 715 ))
682 716
683 '() 717 '()
684 (take 1000 (drop 0x233C rom))) 718 (drop 0x233C rom))
685 719
686 720
687 ))) 721 )))
688 722
689 723