Mercurial > vba-clojure

comparison clojure/com/aurellem/run/bootstrap_1.clj @ 416:21b8b3350b20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
everything works :) now I have total control over the game.
author Robert McIntyre <rlm@mit.edu>
date Sat, 14 Apr 2012 05:41:55 -0500
parents f2f1e0b8c1c7
children 0b6624c1291c
comparison
equal deleted inserted replaced
415:f2f1e0b8c1c7 416:21b8b3350b20
777 0xD162 (+ 0xD162 (count pattern))) 777 0xD162 (+ 0xD162 (count pattern)))
778 (= (subvec (vec (memory (second pattern-insertion))) 778 (= (subvec (vec (memory (second pattern-insertion)))
779 0xD162 (+ 0xD162 (count pattern))) 779 0xD162 (+ 0xD162 (count pattern)))
780 pattern)))) 780 pattern))))
781 781
782 (defn launch-main-bootstrap-program 782 (defn-memo launch-main-bootstrap-program
783 ([] (launch-main-bootstrap-program 783 ([] (launch-main-bootstrap-program
784 (control-checkpoint) 784 (control-checkpoint)
785 ;;(launch-bootstrap-program) 785 ;;(launch-bootstrap-program)
786 )) 786 ))
787 ([script] 787 ([script]
788 (->> script 788 (->> script
789 (play-moves 789 (play-moves
790 (bootstrap-pattern (main-bootstrap-program))) 790 (bootstrap-pattern (main-bootstrap-program)))
791 (play-moves 791 (play-moves
792 (take 263 (interleave (repeat 1000 [:b]) 792 (take 253 (interleave (repeat 1000 [:b])
793 (repeat 1000 []))))))) 793 (repeat 1000 [])))))))
794 794
795 (defn test-main-bootstrap-integrety 795 (defn test-main-bootstrap-integrety
796 [] 796 []
797 (assert 797 (assert
798 (= (main-bootstrap-program) 798 (= (main-bootstrap-program)
809 (->> script 809 (->> script
810 (play-moves 810 (play-moves
811 (map buttons 811 (map buttons
812 [set-H-mode target-high 0x00 812 [set-H-mode target-high 0x00
813 set-L-mode target-low 0x00]))))) 813 set-L-mode target-low 0x00])))))
814 814
815 (defn write-RAM-segment
816 "Assumes that the game is under control of the main-bootstrap
817 program in MODE-SELECT mode and that target-address has been
818 appropriately set, and writes 255 bytes or less to RAM."
819 [segment script]
820 (->> script
821 (play-moves
822 (map buttons
823 [write-mode (count segment)]))
824 (play-moves (map buttons segment))
825 (play-moves [[]])))
826
815 (defn write-RAM 827 (defn write-RAM
816 "Assumes that the game is under control of the main-bootstrap 828 "Assumes that the game is under control of the main-bootstrap
817 program in MODE-SELECT mode, and rewrites RAM starting at 829 program in MODE-SELECT mode, and rewrites RAM starting at
818 'start-address with 'new-ram." 830 'start-address with 'new-ram."
819 [start-address new-ram script] 831 [start-address new-ram script]
820 (->> script 832 (loop [s (set-target-address start-address script)
821 (set-target-address start-address) 833 to-write new-ram]
822 (play-moves [(buttons (count new-ram))]) 834 (if (< (count to-write) 0x100)
823 (play-moves (map buttons new-ram)))) 835 (write-RAM-segment to-write s)
824 836 (recur
837 (write-RAM-segment (take 0xFF to-write) s)
838 (drop 0xFF to-write)))))
839
825 (defn transfer-control 840 (defn transfer-control
826 "Assumes that the game is under control of the main-bootstrap 841 "Assumes that the game is under control of the main-bootstrap
827 program in MODE-SELECT mode, and jumps to the target-address." 842 program in MODE-SELECT mode, and jumps to the target-address."
828 [target-address script] 843 [target-address script]
829 (->> script 844 (->> script
830 (set-target-address target-address) 845 (set-target-address target-address)
831 (play-moves [(buttons jump-mode)]))) 846 (play-moves [(buttons jump-mode)])))
832 847
833 (defn relocate-main-bootstrap 848 (def box-target (+ 90 pokemon-box-1-address))
849
850 (defn-memo relocate-main-bootstrap
834 ([] (relocate-main-bootstrap (launch-main-bootstrap-program))) 851 ([] (relocate-main-bootstrap (launch-main-bootstrap-program)))
835 ([script] 852 ([script]
836 (let [target (+ 90 pokemon-box-1-address)] 853 (let [target (+ 90 pokemon-box-1-address)]
837 (->> script 854 (->> script
838 (do-nothing 500))))) 855 (do-nothing 2)
856 (write-RAM target (main-bootstrap-program target))
857 (do-nothing 1)
858 (transfer-control target)
859 (do-nothing 1)))))
839 860
840 (def mid-game-data 861 (def mid-game-data
841 (subvec (vec (memory (mid-game))) 862 (subvec (vec (memory (mid-game)))
842 pokemon-list-start 863 pokemon-list-start
843 (+ pokemon-list-start 100))) 864 (+ pokemon-list-start 697)))
844 865
845 (def mid-game-map-address 0x46BC) 866 (def mid-game-map-address 0x46BC)
846 867
847 (defn set-mid-game-data 868 (defn set-mid-game-data
848 ([] (set-mid-game-data (relocate-main-bootstrap))) 869 ([] (set-mid-game-data (relocate-main-bootstrap)))
849 ([script] 870 ([script]
850 (->> script 871 (->> script
851 (do-nothing 10) 872 (do-nothing 10)
852 (write-RAM pokemon-list-start mid-game-data)))) 873 (write-RAM pokemon-list-start
853 874 mid-game-data))))
854 875 (defn test-set-data
855 876 ([] (test-set-data (relocate-main-bootstrap)))
856 877 ([script]
878 (->> script
879 (do-nothing 10)
880 (write-RAM pokemon-list-start
881 (repeat 500 0xCC)))))
882
883 (defn test-mid-game-transfer []
884 (= (subvec (vec (memory (second (set-mid-game-data))))
885 pokemon-list-start
886 (+ pokemon-list-start 500))
887 (subvec (vec (memory (mid-game)))
888 pokemon-list-start
889 (+ pokemon-list-start 500))))
890
891 (defn return-to-pokemon-kernel
892 ([] (return-to-pokemon-kernel (set-mid-game-data)))
893 ([script]
894 (let [scratch (+ 200 pokemon-box-1-address)
895 return-program
896 (flatten
897 [0xFB
898 0xC3
899 (reverse (disect-bytes-2 mid-game-map-address))])]
900 (->> script
901 (write-RAM scratch return-program)
902 (transfer-control scratch)
903 (do-nothing 1)))))
904
857 905
906
907
908