rlm@488: (ns com.aurellem.run.image
rlm@486:   (:use (com.aurellem.gb saves gb-driver util constants
rlm@486:                          items vbm characters money
rlm@486:                          rlm-assembly))
rlm@492:   (:use (com.aurellem.run util music title save-corruption
rlm@486:                           bootstrap-0 bootstrap-1))
rlm@486:   (:require clojure.string)
rlm@486:   (:import [com.aurellem.gb.gb_driver SaveState])
rlm@486:   (:import java.io.File))
rlm@486: 
rlm@486: ;; want to display an image onto the screen.
rlm@486: ;; probably will be the six ponies, possibly with scrolling. 
rlm@486: 
rlm@486: ;; probably don't need hi-color mode since the images shuld be
rlm@486: ;; simple. 
rlm@486: 
rlm@486: ;; use background tiles?  they provide greater color depth than
rlm@486: ;; sprites, and can still be scrolled, so why not? 
rlm@486: 
rlm@486: 
rlm@486: ;; First of all, RGB colors in an image are not the same as those in a
rlm@486: ;; GameBoy, so I need to convert them.  Fortunately, this code is
rlm@486: ;; already written for me in this C-code from the public domain
rlm@486: ;; hi-color converter by Glen Cook, Jeff Frohwein, and Rob Jones.
rlm@486: 
rlm@486: ;; the code snipped itself is by Brett Bibby and is translated here
rlm@486: ;; from C into clojure.
rlm@486: 
rlm@486: 
rlm@488: ;; This section of code is used to convert an RGB (pc) triplet into
rlm@488: ;; a RGB (gameboy) triplet. This section of code was kindly donated
rlm@488: ;; by Brett Bibby (GameBrains).
rlm@486: 
rlm@488: ;; BYTE intensity[32] = {
rlm@488: ;;   0x00, 0x10, 0x20, 0x30, 0x40, 0x50, 0x5e, 0x6c, 0x7a, 0x88, 0x94,
rlm@488: ;;   0xa0, 0xae, 0xb7, 0xbf, 0xc6, 0xce, 0xd3, 0xd9, 0xdf, 0xe3, 0xe7,
rlm@488: ;;   0xeb, 0xef, 0xf3, 0xf6, 0xf9, 0xfb, 0xfd, 0xfe, 0xff, 0xff };
rlm@488: 
rlm@488: ;; unsigned char influence[3][3] = 
rlm@488: ;;   {
rlm@488: ;;     {16,4,4},
rlm@488: ;;     {8,16,8},
rlm@488: ;;     {0,8,16}
rlm@488: ;;   };
rlm@488: 
rlm@488: ;; RGBQUAD translate(BYTE rgb[3])
rlm@488: ;; {
rlm@488: ;;   RGBQUAD color;
rlm@488: ;;   BYTE	tmp[3];
rlm@488: ;;   BYTE	m[3][3];
rlm@488: ;;   BYTE	i,j;
rlm@488: 
rlm@488: ;;   for (i=0;i<3;i++)
rlm@488: ;;     for (j=0;j<3;j++)
rlm@488: ;;       m[i][j] = (intensity[rgb[i]>>3]*influence[i][j]) >> 5;
rlm@488: 
rlm@488: ;;   for (i=0;i<3;i++)
rlm@488: ;;     {
rlm@488: ;;       if (m[0][i]>m[1][i])
rlm@488: ;; 	{
rlm@488: ;; 	  j=m[0][i]; 
rlm@488: ;; 	  m[0][i]=m[1][i]; 
rlm@488: ;; 	  m[1][i]=j;
rlm@488: ;; 	}
rlm@488: 
rlm@488: ;;       if (m[1][i]>m[2][i])
rlm@488: ;; 	{
rlm@488: ;; 	  j=m[1][i]; 
rlm@488: ;; 	  m[1][i]=m[2][i]; 
rlm@488: ;; 	  m[2][i]=j;
rlm@488: ;; 	}
rlm@488: 
rlm@488: ;;       if (m[0][i]>m[1][i])
rlm@488: ;; 	{
rlm@488: ;; 	  j=m[0][i]; 
rlm@488: ;; 	  m[0][i]=m[1][i]; 
rlm@488: ;; 	  m[1][i]=j;
rlm@488: ;; 	}
rlm@488: 
rlm@488: ;;       tmp[i]=(((m[0][i]+m[1][i]*2+m[2][i]*4)*5) >> 4)+32;
rlm@488: ;;     }
rlm@488: 
rlm@488: ;;   color.rgbRed	= tmp[0];
rlm@488: ;;   color.rgbGreen	= tmp[1];
rlm@488: ;;   color.rgbBlue	= tmp[2];
rlm@488: 
rlm@488: ;;   return color;
rlm@488: ;; }
rlm@488: 
rlm@488: 
rlm@491:                   
rlm@488: 
rlm@491: (def image-program-target 0xB000)
rlm@486: 
rlm@491: 
rlm@491: (def display-width 160)
rlm@491: (def display-height 144)
rlm@491: 
rlm@491: 
rlm@491: 
rlm@491: ;{:r :g :b }
rlm@491: 
rlm@491: (def character-data     0x8000)
rlm@491: (def character-data-end 0x97FF)
rlm@491: 
rlm@491: 
rlm@491: 
rlm@491: 
rlm@491: (def BG-data-1 0x9800)
rlm@491: 
rlm@491: (def BG-data-2 0x9C00)
rlm@491: 
rlm@491: (def OAM 0xFE00)
rlm@491: 
rlm@491: 
rlm@491: 
rlm@491: (def video-bank-select-register 0xFF4F)
rlm@491: 
rlm@492: (defn gb-rgb->bits [[r g b]]
rlm@492:   (assert (<= 0 r 31))
rlm@492:   (assert (<= 0 g 31))
rlm@492:   (assert (<= 0 b 31))
rlm@491:   [(bit-and
rlm@491:     0xFF
rlm@491:     (+
rlm@491:      r
rlm@491:      (bit-shift-left g 5)))
rlm@491:    (+
rlm@491:     (bit-shift-right g 3)
rlm@491:     (bit-shift-left  b 2))])
rlm@491: 
rlm@492: 
rlm@492: (def bg-palette-select 0xFF68)
rlm@492: (def bg-palette-data   0xFF69)
rlm@492: 
rlm@492: (def obj-palette-select 0xFF6A)
rlm@492: (def obj-palette-data   0xFF6B)
rlm@492: 
rlm@492: (def max-palettes 8)
rlm@492: 
rlm@492: (defn write-data [target data]
rlm@492:     (flatten
rlm@492:      [0x3E ;; load literal to A
rlm@492:       data
rlm@492:       0xEA ;; load A into target
rlm@492:       (disect-bytes-2 target)]))
rlm@492: 
rlm@492: (defn begin-sequential-palette-write
rlm@492:   [palette-num palette-select-address]
rlm@492:   (assert (<= 0 palette-num max-palettes))
rlm@492:   (assert
rlm@492:    (or (= palette-select-address bg-palette-select)
rlm@492:        (= palette-select-address obj-palette-select)))
rlm@492:   (let [palette-write-data
rlm@492:         (Integer/parseInt
rlm@492:          (str "1" ;; auto increment
rlm@492:               "0" ;; not used
rlm@492:               (format
rlm@492:                "%03d"
rlm@492:                (Integer/parseInt
rlm@492:                 (Integer/toBinaryString palette-num) 10))
rlm@492:               "00" ;; color num
rlm@492:               "0"  ;; H/L
rlm@492:               ) 2)]
rlm@492:     (write-data palette-select-address palette-write-data)))
rlm@492:         
rlm@492: (defn set-palettes [palette-select palette-data palettes]
rlm@492:   (assert (<= (count palettes)) max-palettes)
rlm@492:   (flatten 
rlm@492:    [(begin-sequential-palette-write 0 palette-select)
rlm@492:     (map (partial write-data palette-data)
rlm@492:          (flatten (map gb-rgb->bits palettes)))]))
rlm@492: 
rlm@491: (defn display-one-color
rlm@491:   "Displayes a single color onto the gameboy screen. input rgb in
rlm@491:    gameboy rgb."
rlm@492:   [[r g b]]
rlm@492:   ;; construct a kernel that displays a single color
rlm@492:   (let [palettes (repeat 8 [r g b])
rlm@492:         kernel-address 0xC000
rlm@492:         kernel
rlm@492:         (flatten
rlm@492:          [0xF3 ;; disable interrupts
rlm@492:           (frame-metronome)
rlm@492:           (set-palettes
rlm@492:            obj-palette-select
rlm@492:            obj-palette-data
rlm@492:            palettes)
rlm@492:           (set-palettes
rlm@492:            bg-palette-select
rlm@492:            bg-palette-data
rlm@492:            palettes)
rlm@492:           (infinite-loop)])]
rlm@492:     (-> (set-memory-range (second (music-base))
rlm@492:                           kernel-address kernel)
rlm@492:         (PC! kernel-address))))
rlm@492: 
rlm@492: 
rlm@492: 
rlm@491:   
rlm@492: (defn write-palette-color [palette-num r g b]
rlm@492:   (let [[byte-1 byte-2] (gb-rgb->bits r g b)]
rlm@491: 
rlm@491: 
rlm@492:     ))
rlm@491: