rlm@550: ;;;; "Advanced Choreography" -- this is the final video for this project.
rlm@550: 
rlm@550: (ns com.aurellem.run.adv-choreo
rlm@550:   (:use (com.aurellem.gb saves gb-driver util constants
rlm@550:                          items vbm characters money
rlm@550:                          rlm-assembly))
rlm@550:   (:use (com.aurellem.run util music title save-corruption
rlm@550:                           bootstrap-0 bootstrap-1 image
rlm@550:                           ram-display final-cut basic-choreo))
rlm@550:   (:require clojure.string)
rlm@553:   (:import java.awt.image.BufferedImage)
rlm@553:   (:import (javax.imageio ImageWriteParam IIOImage ImageIO))
rlm@550:   (:import [com.aurellem.gb.gb_driver SaveState])
rlm@550:   (:import java.io.File))
rlm@550: 
rlm@550: 
rlm@550: 
rlm@550: ;; Use the gameboy's screen to display the new programming
rlm@550: ;; instead of a side window. This will make it look much
rlm@550: ;; cooler and create a terminal-like effect as the game is
rlm@550: ;; being reprogramed. To do this, use a fixed data entry
rlm@550: ;; region in ram, and run a program that translates this
rlm@550: ;; region into the screen. Every time this data entry region
rlm@550: ;; is full, run a program that copies the data to the
rlm@550: ;; appropriate region in memory. This will cost ~15 seconds
rlm@550: ;; at the beginning to set up, and then should have minimal
rlm@550: ;; overhead (~5%) for the rest of the data transfer, but
rlm@550: ;; will have a good psychological effect for the viewer
rlm@550: ;; since he can see that something is actually happening in
rlm@550: ;; the game.
rlm@550: 
rlm@550: 
rlm@551: ;; Symbol size and type.
rlm@551: 
rlm@551: ;; use fonts from zophar's domain:
rlm@551: ;; http://www.zophar.net/utilities/fonts/8x8-font-archive.html
rlm@551: 
rlm@551: ;; Green font on black background for matrix look.
rlm@551: 
rlm@551: 
rlm@551: (defn program-data [base-address]
rlm@551:   (let [image-program
rlm@551:         (display-image-kernel
rlm@551:          base-address
rlm@554: 
rlm@576:          ;;pinkie-pie-mark
rlm@576:          test-image-color
rlm@554: 
rlm@554:          )
rlm@554:          
rlm@551: 
rlm@551:         music-base-address (+ (count image-program) base-address)
rlm@551: 
rlm@551:         initial-music-data
rlm@551:         (midi-bytes pony-csv 0 0 0 0)
rlm@551:         
rlm@551:         data-lengths
rlm@551:         (map (comp count :data)
rlm@551:                    [(:kernel  initial-music-data)
rlm@551:                     (:voice-1 initial-music-data)
rlm@551:                     (:voice-2 initial-music-data)]);; noise not needed
rlm@551:         addresses
rlm@551:         (map (partial + music-base-address) (reductions + 0 data-lengths))
rlm@551: 
rlm@551:         final-music-data
rlm@551:         (apply (partial midi-bytes pony-csv) addresses)
rlm@551: 
rlm@551:         music-program
rlm@551:         (concat
rlm@551:          (:data (:kernel  final-music-data))
rlm@551:          (:data (:voice-1 final-music-data))
rlm@551:          (:data (:voice-2 final-music-data))
rlm@551:          (:data (:noise   final-music-data)))]
rlm@551: 
rlm@551:     (concat
rlm@551:      image-program ;; image program falls through to music program
rlm@554: 
rlm@576:      (infinite-loop) 
rlm@576:      ;;music-program
rlm@554: 
rlm@554:      )))
rlm@551: 
rlm@551: 
rlm@551: 
rlm@553: 
rlm@553: (def glyphs
rlm@553:   "The sixteen 8x8 glyphs which make up the \"terminal\" font."
rlm@553:   (mapv #(ImageIO/read
rlm@553:           (File. user-home (str "proj/vba-clojure/font/" % ".png")))
rlm@553:           ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"]))
rlm@553: 
rlm@554: (defn glyph-init-program
rlm@553:   [start-address]
rlm@553:   (let [zero-glyph (image->gb-image (glyphs 0))
rlm@553:         
rlm@553:         ;; write same pallet information to all pallettes
rlm@553:         A (flatten
rlm@554:            [(write-byte LCD-control-register 0x00);; disable LCD protection
rlm@553:             (set-palettes bg-palette-select bg-palette-data
rlm@553:                           (repeat 8 (first (:palettes zero-glyph))))
rlm@553:             (select-LCD-bank 0)
rlm@553:             (write-byte SCX-register 0)
rlm@553:             (write-byte SCY-register 0)])
rlm@553:         B (flatten
rlm@553:            [(write-data 
rlm@553:              (+ start-address (count A))
rlm@553:              character-data-address
rlm@553:              (flatten
rlm@553:               (map (comp gb-tile->bytes first :tiles image->gb-image)
rlm@554:                    glyphs)))
rlm@553: 
rlm@554:             
rlm@554:             (write-byte
rlm@554:              LCD-control-register
rlm@554:              (Integer/parseInt
rlm@554:               (str
rlm@554:                "1"  ;; LCDC on/off
rlm@554:                "0"  ;; Window code area
rlm@554:                "0"  ;; Windowing on?
rlm@554:                "1"  ;; BG tile base (1 = 0x8000)
rlm@554:                "0"  ;; BG-1 or BG-2 ?
rlm@554:                "0"  ;; OBJ-block composition
rlm@554:                "0"  ;; OBJ-on flag 
rlm@554:                "1") ;; no-effect 
rlm@554:               2))])]
rlm@554:     (concat A B )))
rlm@553: 
rlm@558: 
rlm@560:  
rlm@553: (defn glyph-display-program
rlm@577:   [start-address]
rlm@556:   (let [data-start (+ 2 start-address)
rlm@557:         load-data
rlm@557:         (flatten
rlm@557:          [;; data region
rlm@557:           0x18
rlm@576:           2
rlm@571:           0 0 ;; current row and column
rlm@557:           ;; save all registers
rlm@557:           0xC5 0xD5 0xE5 0xF5
rlm@557: 
rlm@557:           ;; load data from data region into registers
rlm@562: 
rlm@577:           0xF5 ;; push A, which contains current glyph
rlm@577: 
rlm@577:           0x21
rlm@558:           (reverse (disect-bytes-2 data-start))
rlm@577:           ;; load row and column into DE
rlm@577:           0x2A 0x57 ;; row -> D
rlm@577:           0x2A 0x5F ;; column -> E
rlm@557: 
rlm@577: 
rlm@557:           ])
rlm@557: 
rlm@560: 
rlm@562:         display-glyph
rlm@568:         (let [init*
rlm@563:               (flatten
rlm@577:                [(repeat 100 0)
rlm@565:                 ;; Reset HL to initial value
rlm@567: 
rlm@568:                 ;; clear screen if we are at 0,0
rlm@568:                 0x57 0xB3 ;; D->A, OR E A ==> (= D E 0)
rlm@571:                 0x20 ;; skip clear-screen if D and E are not both zero
rlm@572:                 :clear-screen-length])
rlm@562: 
rlm@563:               clear-screen
rlm@568:               (flatten
rlm@569:                [;; save all registers
rlm@569:                 0xC5 0xD5 0xE5 0xF5
rlm@569: 
rlm@570:                 (select-LCD-bank 0)
rlm@570:                 ;; write 0x00 to memory locations
rlm@570:                 ;; 0x9800 to 0x9A34
rlm@570:                 0x21
rlm@570:                 0x00 0x98 ;; load 0x9800 into HL
rlm@570: 
rlm@570:                 
rlm@570:                 0x16 3 ;; 3 -> D
rlm@570:                 0x1E 190 ;; 188 -> E
rlm@570: 
rlm@570:                 0x3E 0 ;; 0-> A
rlm@570: 
rlm@570:                 ;; begin of do-while loop
rlm@570:                    0x22 ;; load 0 to 0x9800
rlm@570:                    0x1D ;; dec E
rlm@570:                    0x20
rlm@570:                    (->signed-8-bit -4)
rlm@570:                    0x15 ;; dec D
rlm@570:                    0x1E 190 ;; 188 -> E
rlm@570:                    0x20
rlm@570:                    (->signed-8-bit -8)
rlm@570:                 ;; end of do-while-loop
rlm@572: 
rlm@569:                 ;; restore all registers
rlm@572:                 0xF1 0xE1 0xD1 0xC1])
rlm@572: 
rlm@577:               ;; RLM: for TESTING ONLY!!!
rlm@579:               clear-screen (repeat 10 0)
rlm@573:               increment-row-column
rlm@573:               [;; D contains row and E contains column
rlm@573:                
rlm@573:                ;; every time column (E) reaches 20, set
rlm@573:                ;; column to 0 and increment row
rlm@573:                0x1C ;; inc E
rlm@573:                0x3E 20 0xBB ;; compare E to 20
rlm@578:                0x20
rlm@579:                3
rlm@579:                0x14
rlm@578:                0x1E 0
rlm@578:                
rlm@579: 
rlm@579:                0x3E 18
rlm@579:                0xBA
rlm@579:                0x20
rlm@579:                2
rlm@579:                0x16 0
rlm@573: 
rlm@578:                ;; 0x00 ;;0x1C ;; inc E
rlm@578:                ;; 0x3E 20 0xBB ;; compare E to 20
rlm@578:                ;; 0x20 ;; if E is 20
rlm@578:                ;;   3
rlm@578:                ;;   0x1E 0 ;; set E to zero
rlm@578:                ;;   0x00; 0x14   ;; (inc D) -> D
rlm@578: 
rlm@578:                ;; ;; every time row (D) reaches 18, set row to 0                
rlm@578:                ;; 0x3E 18 0xBA ;; compare D to 18
rlm@578:                ;; 0x20 ;; if D is 18
rlm@578:                ;;   2
rlm@578:                ;;   0x16 0
rlm@578:                ] ;; set D to zero
rlm@573:                
rlm@573:               set-HL-from-row-and-column
rlm@581:               (flatten
rlm@573:               [;; formula for memory offset is:
rlm@577:                ;; (+ 0x9800 (* 32 row) column) == 
rlm@577:                ;; (+ 0x97E0 (* 32 (+ 1 row)) column)
rlm@581:                0xD5 ;; push DE
rlm@573: 
rlm@579:                ;; RLM: this should be 0x9800, investigate
rlm@581:                0x21 0x00 0x98 ;; load HL with something
rlm@577:                
rlm@577:                0x06 0
rlm@581:                0x4B  ;; columns (E) -> BC
rlm@581:                0x09  ;; HL += columns
rlm@573: 
rlm@579: 
rlm@579:                0xAF ;; 0 -> A
rlm@579:                
rlm@579:                0x06 0
rlm@579:                0x0E 32     ;; load 32 into BC
rlm@579: 
rlm@581:                0xBA ;; CP A D
rlm@579:                0x20
rlm@579:                4
rlm@581:                ;;(+ 32 3)
rlm@579:                0x09 ;; HL += 32
rlm@581:                ;;(repeat 32 0x23)
rlm@579:                0x3C
rlm@579:                0x18
rlm@581:                ;;(->signed-8-bit (+ -6 -32))
rlm@579:                (->signed-8-bit -7)
rlm@578:                ;; 0x14 ;; inc D to handle case where D == 0
rlm@578:                ;; ;; D will never be > 20, so this will never overflow.
rlm@578: 
rlm@578:                ;; ;; do 
rlm@578:                ;;   0x09 ;; HL += 32
rlm@578:                ;;   0x15 ;; dec D
rlm@578:                ;; ;; while D != 0
rlm@578:                ;; 0x20 
rlm@578:                ;; (->signed-8-bit -4)
rlm@577:                
rlm@581:                0xD1 ;; pop DE
rlm@581:                ])
rlm@573:               
rlm@572:               render-glyph
rlm@572:               (flatten
rlm@577:                [;; Render each nybble of A as a character
rlm@577:                 ;; there are two characters to a glyph.
rlm@579:                 0x21
rlm@579:                 (reverse (disect-bytes-2 data-start))
rlm@579:                 ;; load row and column into DE
rlm@579:                 0x2A 0x57 ;; row -> D
rlm@579:                 0x2A 0x5F ;; column -> E
rlm@581: 
rlm@581:                 
rlm@577:                 set-HL-from-row-and-column
rlm@581: 
rlm@575:                 0xF1 ;; pop A, now A is equal to key input
rlm@581:                 0x3E 0xFF ;; RLM: TESTING set A = 0xFF
rlm@575:                 0xF5 ;; save A
rlm@575: 
rlm@575:                 0xE6 0xF0 ;; clear second nybble
rlm@575:                 0xCB 0x37 ;; swap nybbles
rlm@579:                 0x77 ;; store A in video RAM as a character (pun)
rlm@577:                 increment-row-column
rlm@581: 
rlm@581: 
rlm@577:                 set-HL-from-row-and-column
rlm@581: 
rlm@575:                 0xF1 ;; restore A
rlm@575:                 0xE6 0x0F ;; select second nybble
rlm@579:                 0x77 ;; store second nybble as character
rlm@575:                 increment-row-column
rlm@577:                  ])
rlm@563: 
rlm@572:               
rlm@568:               init (replace
rlm@568:                     {:clear-screen-length (count clear-screen)} init*)
rlm@568:               ]
rlm@568:           
rlm@572:               (concat init clear-screen render-glyph))
rlm@563:               
rlm@557:         cleanup
rlm@557:         ;; restore all registers
rlm@562:         (flatten
rlm@576:          [;; Reset HL to initial value
rlm@558:           0x21
rlm@558:           (reverse (disect-bytes-2 data-start))
rlm@579:           ;;0x23
rlm@579:           0x7A 0x22 ;; D -> rows       -> to RAM
rlm@569:           0x7B 0x22 ;; E -> columns
rlm@558:           ])
rlm@558:          
rlm@558:         stack-cleanup
rlm@557:         [0xF1 0xE1 0xD1 0xC1]
rlm@576:         ]
rlm@558:     (concat load-data
rlm@558:             display-glyph
rlm@558:             cleanup stack-cleanup)))
rlm@556: 
rlm@556: (def main-program-base-address 0xC000)
rlm@553: 
rlm@553: (defn glyph-bootstrap-program
rlm@553:   [start-address delay-count total-glyph-count]
rlm@553:   (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B
rlm@554:         header (concat  (frame-metronome) (read-user-input))
rlm@553: 
rlm@553:         glyph-display (glyph-display-program
rlm@559:                        (+ (count init)
rlm@562:                           (count header)
rlm@577:                           start-address))
rlm@558:                        ;;(- (count (program-data 0)) 100))
rlm@553: 
rlm@553:         state-machine-start-address
rlm@553:         (+ start-address (count init) (count header) (count glyph-display))
rlm@553:         state-machine
rlm@553:         (bootstrap-state-machine state-machine-start-address)
rlm@553:         
rlm@553:         return-to-header
rlm@553:         (flatten 
rlm@564:          [0xC3
rlm@564:           (reverse  (disect-bytes-2
rlm@564:                      (+ (count init) start-address)))])]
rlm@562:     (concat init header glyph-display state-machine return-to-header)))
rlm@553: 
rlm@556: 
rlm@551: 
rlm@558: (defn-memo begin-glyph-bootstrap
rlm@554:   ([] (begin-glyph-bootstrap (launch-main-bootstrap-program)))
rlm@554:   ([script]
rlm@554:      (let [glyph-init (glyph-init-program relocated-bootstrap-start)
rlm@554:            main-glyph-start (+ relocated-bootstrap-start
rlm@554:                                    (count glyph-init))
rlm@554:            glyph-program (glyph-bootstrap-program
rlm@554:                           main-glyph-start 0 0)]
rlm@554:        (->> script
rlm@554:             (do-nothing 2)
rlm@554:             ;; begin glyph program
rlm@554:             (write-RAM 0xFF1A [0 0 0]) ;; silence remnant music
rlm@554:            
rlm@554:             (write-RAM
rlm@554:              relocated-bootstrap-start
rlm@554:              (concat glyph-init glyph-program))
rlm@554:             (transfer-control relocated-bootstrap-start)
rlm@555:             (do-nothing 1)
rlm@553: 
rlm@554:             ))))
rlm@553: 
rlm@551: (defn write-all-program-data
rlm@554:   ([] (write-all-program-data (begin-glyph-bootstrap)))
rlm@551:   ([script]
rlm@551:      (let [base-address main-program-base-address]
rlm@551:        (->> script
rlm@551:             (write-RAM base-address (program-data base-address))))))
rlm@551: 
rlm@551: (defn activate-program
rlm@551:   ([] (activate-program (write-all-program-data)))
rlm@551:   ([script]
rlm@551:      (->> script
rlm@551:           (transfer-control main-program-base-address)
rlm@554:           ;;(do-nothing 1800)
rlm@554:           (do-nothing 50)
rlm@554:           )))
rlm@552: 
rlm@552: 
rlm@552: ;; possible screen writing programs
rlm@552: 
rlm@552: ;; (program needs to stop executing at some point)
rlm@552: ;; maybe have total length counter or something?
rlm@552: 
rlm@552: ;; automatic counter that reads from program-start and clears the
rlm@552: ;; screen every 360 (* 18 20) gliphs
rlm@552: 
rlm@552: ;; advantages -- very simple and low bandwidth
rlm@552: ;; disadvantages -- hard to align counter
rlm@552: 
rlm@552: ;; implementation -- refactor main-bootstrap-program to provide a
rlm@552: ;; state-machine code-section which can be recombined into another
rlm@552: ;; program.