Mercurial > vba-clojure

annotate clojure/com/aurellem/run/image.clj @ 495:1d81ddd4fa41

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merged changes from trip to wichita.
author Robert McIntyre <rlm@mit.edu>
date Mon, 11 Jun 2012 00:55:51 -0500
parents 151c96d60921 79606f173658
children a6d060a64246
rev   line source
rlm@488 1 (ns com.aurellem.run.image
rlm@486 2 (:use (com.aurellem.gb saves gb-driver util constants
rlm@486 3 items vbm characters money
rlm@486 4 rlm-assembly))
rlm@492 5 (:use (com.aurellem.run util music title save-corruption
rlm@486 6 bootstrap-0 bootstrap-1))
rlm@486 7 (:require clojure.string)
rlm@486 8 (:import [com.aurellem.gb.gb_driver SaveState])
rlm@486 9 (:import java.io.File))
rlm@486 10
rlm@486 11 ;; want to display an image onto the screen.
rlm@486 12 ;; probably will be the six ponies, possibly with scrolling.
rlm@486 13
rlm@486 14 ;; probably don't need hi-color mode since the images shuld be
rlm@486 15 ;; simple.
rlm@486 16
rlm@486 17 ;; use background tiles? they provide greater color depth than
rlm@486 18 ;; sprites, and can still be scrolled, so why not?
rlm@486 19
rlm@490 20 ;; could also use sprites to get 3 more colors per tile for a total of
rlm@490 21 ;; 7 colors per tile, although not for all tiles...
rlm@486 22
rlm@486 23
rlm@486 24
rlm@490 25 ;; want a function to
rlm@486 26
rlm@490 27 ;; 1. read an image
rlm@490 28 ;; 2. split into a grid of 8x8 pixels
rlm@490 29 ;; 3. convert all RGB colors to gb-RGB colors
rlm@490 30 ;; 4. determine efficient color palletes for the image
rlm@490 31 ;; 5. output efficient assembly code to draw the image to the gb
rlm@490 32 ;; screen.
rlm@486 33
rlm@488 34
rlm@488 35
rlm@488 36
rlm@488 37
rlm@488 38
rlm@488 39
rlm@488 40
rlm@488 41
rlm@488 42
rlm@488 43
rlm@488 44
rlm@488 45
rlm@491 46 (def image-program-target 0xB000)
rlm@486 47
rlm@491 48 (def display-width 160)
rlm@491 49 (def display-height 144)
rlm@491 50
rlm@491 51
rlm@491 52
rlm@491 53 ;{:r :g :b }
rlm@491 54
rlm@491 55 (def character-data 0x8000)
rlm@491 56 (def character-data-end 0x97FF)
rlm@491 57
rlm@491 58
rlm@491 59
rlm@491 60
rlm@491 61 (def BG-data-1 0x9800)
rlm@491 62
rlm@491 63 (def BG-data-2 0x9C00)
rlm@491 64
rlm@491 65 (def OAM 0xFE00)
rlm@491 66
rlm@491 67
rlm@491 68
rlm@491 69 (def video-bank-select-register 0xFF4F)
rlm@491 70
rlm@492 71 (defn gb-rgb->bits [[r g b]]
rlm@492 72 (assert (<= 0 r 31))
rlm@492 73 (assert (<= 0 g 31))
rlm@492 74 (assert (<= 0 b 31))
rlm@491 75 [(bit-and
rlm@491 76 0xFF
rlm@491 77 (+
rlm@491 78 r
rlm@491 79 (bit-shift-left g 5)))
rlm@491 80 (+
rlm@491 81 (bit-shift-right g 3)
rlm@491 82 (bit-shift-left b 2))])
rlm@491 83
rlm@492 84
rlm@492 85 (def bg-palette-select 0xFF68)
rlm@492 86 (def bg-palette-data 0xFF69)
rlm@492 87
rlm@492 88 (def obj-palette-select 0xFF6A)
rlm@492 89 (def obj-palette-data 0xFF6B)
rlm@492 90
rlm@492 91 (def max-palettes 8)
rlm@492 92
rlm@492 93 (defn write-data [target data]
rlm@492 94 (flatten
rlm@492 95 [0x3E ;; load literal to A
rlm@492 96 data
rlm@492 97 0xEA ;; load A into target
rlm@493 98 (reverse (disect-bytes-2 target))]))
rlm@492 99
rlm@492 100 (defn begin-sequential-palette-write
rlm@492 101 [palette-num palette-select-address]
rlm@492 102 (assert (<= 0 palette-num max-palettes))
rlm@492 103 (assert
rlm@492 104 (or (= palette-select-address bg-palette-select)
rlm@492 105 (= palette-select-address obj-palette-select)))
rlm@492 106 (let [palette-write-data
rlm@492 107 (Integer/parseInt
rlm@492 108 (str "1" ;; auto increment
rlm@492 109 "0" ;; not used
rlm@492 110 (format
rlm@492 111 "%03d"
rlm@492 112 (Integer/parseInt
rlm@492 113 (Integer/toBinaryString palette-num) 10))
rlm@492 114 "00" ;; color num
rlm@492 115 "0" ;; H/L
rlm@492 116 ) 2)]
rlm@492 117 (write-data palette-select-address palette-write-data)))
rlm@492 118
rlm@492 119 (defn set-palettes [palette-select palette-data palettes]
rlm@492 120 (assert (<= (count palettes)) max-palettes)
rlm@492 121 (flatten
rlm@492 122 [(begin-sequential-palette-write 0 palette-select)
rlm@492 123 (map (partial write-data palette-data)
rlm@492 124 (flatten (map gb-rgb->bits palettes)))]))
rlm@492 125
rlm@491 126 (defn display-one-color
rlm@491 127 "Displayes a single color onto the gameboy screen. input rgb in
rlm@491 128 gameboy rgb."
rlm@492 129 [[r g b]]
rlm@492 130 ;; construct a kernel that displays a single color
rlm@494 131 (let
rlm@494 132 [palettes (repeat 8 [r g b])
rlm@494 133 kernel-address 0xC000
rlm@494 134 kernel
rlm@494 135 [0xF3 ;; disable interrupts
rlm@494 136 (clear-music-registers)
rlm@494 137 (frame-metronome)
rlm@494 138 (set-palettes obj-palette-select obj-palette-data palettes)
rlm@494 139 (set-palettes bg-palette-select bg-palette-data palettes)
rlm@494 140 (infinite-loop)]]
rlm@492 141 (-> (set-memory-range (second (music-base))
rlm@494 142 kernel-address (flatten kernel))
rlm@492 143 (PC! kernel-address))))
rlm@492 144
rlm@492 145
rlm@492 146
rlm@491 147
rlm@492 148 (defn write-palette-color [palette-num r g b]
rlm@492 149 (let [[byte-1 byte-2] (gb-rgb->bits r g b)]
rlm@491 150
rlm@491 151
rlm@492 152 ))
rlm@491 153
rlm@495 154