Mercurial > vba-clojure

annotate clojure/com/aurellem/run/image.clj @ 493:783a09c84a28

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
can now display a single color :)
author Robert McIntyre <rlm@mit.edu>
date Thu, 07 Jun 2012 23:03:05 -0500
parents 716752719a78
children 79606f173658
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@486 20
rlm@486 21 ;; First of all, RGB colors in an image are not the same as those in a
rlm@486 22 ;; GameBoy, so I need to convert them. Fortunately, this code is
rlm@486 23 ;; already written for me in this C-code from the public domain
rlm@486 24 ;; hi-color converter by Glen Cook, Jeff Frohwein, and Rob Jones.
rlm@486 25
rlm@486 26 ;; the code snipped itself is by Brett Bibby and is translated here
rlm@486 27 ;; from C into clojure.
rlm@486 28
rlm@486 29
rlm@488 30 ;; This section of code is used to convert an RGB (pc) triplet into
rlm@488 31 ;; a RGB (gameboy) triplet. This section of code was kindly donated
rlm@488 32 ;; by Brett Bibby (GameBrains).
rlm@486 33
rlm@488 34 ;; BYTE intensity[32] = {
rlm@488 35 ;; 0x00, 0x10, 0x20, 0x30, 0x40, 0x50, 0x5e, 0x6c, 0x7a, 0x88, 0x94,
rlm@488 36 ;; 0xa0, 0xae, 0xb7, 0xbf, 0xc6, 0xce, 0xd3, 0xd9, 0xdf, 0xe3, 0xe7,
rlm@488 37 ;; 0xeb, 0xef, 0xf3, 0xf6, 0xf9, 0xfb, 0xfd, 0xfe, 0xff, 0xff };
rlm@488 38
rlm@488 39 ;; unsigned char influence[3][3] =
rlm@488 40 ;; {
rlm@488 41 ;; {16,4,4},
rlm@488 42 ;; {8,16,8},
rlm@488 43 ;; {0,8,16}
rlm@488 44 ;; };
rlm@488 45
rlm@488 46 ;; RGBQUAD translate(BYTE rgb[3])
rlm@488 47 ;; {
rlm@488 48 ;; RGBQUAD color;
rlm@488 49 ;; BYTE tmp[3];
rlm@488 50 ;; BYTE m[3][3];
rlm@488 51 ;; BYTE i,j;
rlm@488 52
rlm@488 53 ;; for (i=0;i<3;i++)
rlm@488 54 ;; for (j=0;j<3;j++)
rlm@488 55 ;; m[i][j] = (intensity[rgb[i]>>3]*influence[i][j]) >> 5;
rlm@488 56
rlm@488 57 ;; for (i=0;i<3;i++)
rlm@488 58 ;; {
rlm@488 59 ;; if (m[0][i]>m[1][i])
rlm@488 60 ;; {
rlm@488 61 ;; j=m[0][i];
rlm@488 62 ;; m[0][i]=m[1][i];
rlm@488 63 ;; m[1][i]=j;
rlm@488 64 ;; }
rlm@488 65
rlm@488 66 ;; if (m[1][i]>m[2][i])
rlm@488 67 ;; {
rlm@488 68 ;; j=m[1][i];
rlm@488 69 ;; m[1][i]=m[2][i];
rlm@488 70 ;; m[2][i]=j;
rlm@488 71 ;; }
rlm@488 72
rlm@488 73 ;; if (m[0][i]>m[1][i])
rlm@488 74 ;; {
rlm@488 75 ;; j=m[0][i];
rlm@488 76 ;; m[0][i]=m[1][i];
rlm@488 77 ;; m[1][i]=j;
rlm@488 78 ;; }
rlm@488 79
rlm@488 80 ;; tmp[i]=(((m[0][i]+m[1][i]*2+m[2][i]*4)*5) >> 4)+32;
rlm@488 81 ;; }
rlm@488 82
rlm@488 83 ;; color.rgbRed = tmp[0];
rlm@488 84 ;; color.rgbGreen = tmp[1];
rlm@488 85 ;; color.rgbBlue = tmp[2];
rlm@488 86
rlm@488 87 ;; return color;
rlm@488 88 ;; }
rlm@488 89
rlm@488 90
rlm@491 91
rlm@488 92
rlm@491 93 (def image-program-target 0xB000)
rlm@486 94
rlm@491 95
rlm@491 96 (def display-width 160)
rlm@491 97 (def display-height 144)
rlm@491 98
rlm@491 99
rlm@491 100
rlm@491 101 ;{:r :g :b }
rlm@491 102
rlm@491 103 (def character-data 0x8000)
rlm@491 104 (def character-data-end 0x97FF)
rlm@491 105
rlm@491 106
rlm@491 107
rlm@491 108
rlm@491 109 (def BG-data-1 0x9800)
rlm@491 110
rlm@491 111 (def BG-data-2 0x9C00)
rlm@491 112
rlm@491 113 (def OAM 0xFE00)
rlm@491 114
rlm@491 115
rlm@491 116
rlm@491 117 (def video-bank-select-register 0xFF4F)
rlm@491 118
rlm@492 119 (defn gb-rgb->bits [[r g b]]
rlm@492 120 (assert (<= 0 r 31))
rlm@492 121 (assert (<= 0 g 31))
rlm@492 122 (assert (<= 0 b 31))
rlm@491 123 [(bit-and
rlm@491 124 0xFF
rlm@491 125 (+
rlm@491 126 r
rlm@491 127 (bit-shift-left g 5)))
rlm@491 128 (+
rlm@491 129 (bit-shift-right g 3)
rlm@491 130 (bit-shift-left b 2))])
rlm@491 131
rlm@492 132
rlm@492 133 (def bg-palette-select 0xFF68)
rlm@492 134 (def bg-palette-data 0xFF69)
rlm@492 135
rlm@492 136 (def obj-palette-select 0xFF6A)
rlm@492 137 (def obj-palette-data 0xFF6B)
rlm@492 138
rlm@492 139 (def max-palettes 8)
rlm@492 140
rlm@492 141 (defn write-data [target data]
rlm@492 142 (flatten
rlm@492 143 [0x3E ;; load literal to A
rlm@492 144 data
rlm@492 145 0xEA ;; load A into target
rlm@493 146 (reverse (disect-bytes-2 target))]))
rlm@492 147
rlm@492 148 (defn begin-sequential-palette-write
rlm@492 149 [palette-num palette-select-address]
rlm@492 150 (assert (<= 0 palette-num max-palettes))
rlm@492 151 (assert
rlm@492 152 (or (= palette-select-address bg-palette-select)
rlm@492 153 (= palette-select-address obj-palette-select)))
rlm@492 154 (let [palette-write-data
rlm@492 155 (Integer/parseInt
rlm@492 156 (str "1" ;; auto increment
rlm@492 157 "0" ;; not used
rlm@492 158 (format
rlm@492 159 "%03d"
rlm@492 160 (Integer/parseInt
rlm@492 161 (Integer/toBinaryString palette-num) 10))
rlm@492 162 "00" ;; color num
rlm@492 163 "0" ;; H/L
rlm@492 164 ) 2)]
rlm@492 165 (write-data palette-select-address palette-write-data)))
rlm@492 166
rlm@492 167 (defn set-palettes [palette-select palette-data palettes]
rlm@492 168 (assert (<= (count palettes)) max-palettes)
rlm@492 169 (flatten
rlm@492 170 [(begin-sequential-palette-write 0 palette-select)
rlm@492 171 (map (partial write-data palette-data)
rlm@492 172 (flatten (map gb-rgb->bits palettes)))]))
rlm@492 173
rlm@491 174 (defn display-one-color
rlm@491 175 "Displayes a single color onto the gameboy screen. input rgb in
rlm@491 176 gameboy rgb."
rlm@492 177 [[r g b]]
rlm@492 178 ;; construct a kernel that displays a single color
rlm@492 179 (let [palettes (repeat 8 [r g b])
rlm@492 180 kernel-address 0xC000
rlm@492 181 kernel
rlm@492 182 (flatten
rlm@492 183 [0xF3 ;; disable interrupts
rlm@492 184 (frame-metronome)
rlm@492 185 (set-palettes
rlm@492 186 obj-palette-select
rlm@492 187 obj-palette-data
rlm@492 188 palettes)
rlm@492 189 (set-palettes
rlm@492 190 bg-palette-select
rlm@492 191 bg-palette-data
rlm@492 192 palettes)
rlm@492 193 (infinite-loop)])]
rlm@492 194 (-> (set-memory-range (second (music-base))
rlm@492 195 kernel-address kernel)
rlm@492 196 (PC! kernel-address))))
rlm@492 197
rlm@492 198
rlm@492 199
rlm@491 200
rlm@492 201 (defn write-palette-color [palette-num r g b]
rlm@492 202 (let [[byte-1 byte-2] (gb-rgb->bits r g b)]
rlm@491 203
rlm@491 204
rlm@492 205 ))
rlm@491 206