Mercurial > vba-clojure

     1 ;;;; "Advanced Choreography" -- this is the final video for this project.

     2 

     3 (ns com.aurellem.run.adv-choreo

     4   (:use (com.aurellem.gb saves gb-driver util constants

     5                          items vbm characters money

     6                          rlm-assembly))

     7   (:use (com.aurellem.run util music title save-corruption

     8                           bootstrap-0 bootstrap-1 image

     9                           ram-display final-cut basic-choreo))

    10   (:require clojure.string)

    11   (:import java.awt.image.BufferedImage)

    12   (:import (javax.imageio ImageWriteParam IIOImage ImageIO))

    13   (:import [com.aurellem.gb.gb_driver SaveState])

    14   (:import java.io.File))

    15 

    16 

    17 

    18 ;; Use the gameboy's screen to display the new programming

    19 ;; instead of a side window. This will make it look much

    20 ;; cooler and create a terminal-like effect as the game is

    21 ;; being reprogramed. To do this, use a fixed data entry

    22 ;; region in ram, and run a program that translates this

    23 ;; region into the screen. Every time this data entry region

    24 ;; is full, run a program that copies the data to the

    25 ;; appropriate region in memory. This will cost ~15 seconds

    26 ;; at the beginning to set up, and then should have minimal

    27 ;; overhead (~5%) for the rest of the data transfer, but

    28 ;; will have a good psychological effect for the viewer

    29 ;; since he can see that something is actually happening in

    30 ;; the game.

    31 

    32 

    33 ;; Symbol size and type.

    34 

    35 ;; use fonts from zophar's domain:

    36 ;; http://www.zophar.net/utilities/fonts/8x8-font-archive.html

    37 

    38 ;; Green font on black background for matrix look.

    39 

    40 

    41 (defn program-data [base-address]

    42   (let [image-program

    43         (display-image-kernel

    44          base-address

    45 

    46          ;;pinkie-pie-mark

    47          test-image-color

    48 

    49          )

    50          

    51 

    52         music-base-address (+ (count image-program) base-address)

    53 

    54         initial-music-data

    55         (midi-bytes pony-csv 0 0 0 0)

    56         

    57         data-lengths

    58         (map (comp count :data)

    59                    [(:kernel  initial-music-data)

    60                     (:voice-1 initial-music-data)

    61                     (:voice-2 initial-music-data)]);; noise not needed

    62         addresses

    63         (map (partial + music-base-address) (reductions + 0 data-lengths))

    64 

    65         final-music-data

    66         (apply (partial midi-bytes pony-csv) addresses)

    67 

    68         music-program

    69         (concat

    70          (:data (:kernel  final-music-data))

    71          (:data (:voice-1 final-music-data))

    72          (:data (:voice-2 final-music-data))

    73          (:data (:noise   final-music-data)))]

    74 

    75     (concat

    76      image-program ;; image program falls through to music program

    77 

    78      (infinite-loop) 

    79      ;;music-program

    80 

    81      )))

    82 

    83 

    84 

    85 

    86 (def glyphs

    87   "The sixteen 8x8 glyphs which make up the \"terminal\" font."

    88   (mapv #(ImageIO/read

    89           (File. user-home (str "proj/vba-clojure/font/" % ".png")))

    90           ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"]))

    91 

    92 (defn glyph-init-program

    93   [start-address]

    94   (let [zero-glyph (image->gb-image (glyphs 0))

    95         

    96         ;; write same pallet information to all pallettes

    97         A (flatten

    98            [(write-byte LCD-control-register 0x00);; disable LCD protection

    99             (set-palettes bg-palette-select bg-palette-data

   100                           (repeat 8 (first (:palettes zero-glyph))))

   101             (select-LCD-bank 0)

   102             (write-byte SCX-register 0)

   103             (write-byte SCY-register 0)])

   104         B (flatten

   105            [(write-data 

   106              (+ start-address (count A))

   107              character-data-address

   108              (flatten

   109               (map (comp gb-tile->bytes first :tiles image->gb-image)

   110                    glyphs)))

   111 

   112             

   113             (write-byte

   114              LCD-control-register

   115              (Integer/parseInt

   116               (str

   117                "1"  ;; LCDC on/off

   118                "0"  ;; Window code area

   119                "0"  ;; Windowing on?

   120                "1"  ;; BG tile base (1 = 0x8000)

   121                "0"  ;; BG-1 or BG-2 ?

   122                "0"  ;; OBJ-block composition

   123                "0"  ;; OBJ-on flag 

   124                "1") ;; no-effect 

   125               2))])]

   126     (concat A B )))

   127 

   128 (defn glyph-display-program

   129   [start-address

   130    monitor-address

   131    delay-count

   132    total-glyph-count]

   133   (let [data-start (+ 2 start-address)

   134         monitor-address-high (+ 0 data-start)

   135         monitor-address-low  (+ 1 data-start)

   136 

   137         glyph-count-high     (+ 2 data-start)

   138         glyph-count-low      (+ 3 data-start)

   139 

   140         delay-address        (+ 4 data-start)]

   141         

   142         

   143   (flatten

   144    [;; data region

   145 

   146     0x18

   147     5

   148     (disect-bytes-2 monitor-address)

   149     (disect-bytes-2 total-glyph-count)

   150     delay-count

   151 

   152     ;; save all registers

   153     0xC5 0xD5 0xE5 0xF5

   154 

   155     ;; load data from data region into registers

   156 

   157     0x21

   158     (disect-bytes-2 monitor-address-high)

   159 

   160     0x2A 0x47 ;; monitor-address-high -> B

   161     0x2A 0x4F ;; monitor-address-low  -> C

   162 

   163     0x2A 0x57 ;; glyph-count-high -> D

   164     0x2A 0x5F ;; glyph-count-low  -> E

   165 

   166     0x2A ;; delay -> A 

   167     

   168 

   169     

   170     

   171     ;; restore all registers

   172     0xF1 0xE1 0xD1 0xC1

   173    ])))

   174 

   175 (def main-program-base-address 0xC000)

   176 

   177 (defn glyph-bootstrap-program

   178   [start-address delay-count total-glyph-count]

   179   (let [init [0xAF 0x4F 0x47] ;; 0->A; 0->C; 0->B

   180         header (concat  (frame-metronome) (read-user-input))

   181 

   182         glyph-display (glyph-display-program

   183                        (+ (count init) (count header)

   184                           start-address)

   185                        main-program-base-address 100

   186                        (- (count (program-data 0)) 100))

   187 

   188         state-machine-start-address

   189         (+ start-address (count init) (count header) (count glyph-display))

   190         state-machine

   191         (bootstrap-state-machine state-machine-start-address)

   192         

   193         return-to-header

   194         (flatten 

   195          [0x18

   196           (->signed-8-bit

   197            (- (count init)

   198               2 ;; this command length

   199               3 ;; I have no idea why we need a 3 here

   200               ;; need to investigate.

   201               (count glyph-display)

   202               (count header)

   203               (count state-machine)))])]

   204     

   205     (concat init glyph-display header state-machine return-to-header)))

   206 

   207 

   208 

   209 (defn begin-glyph-bootstrap

   210   ([] (begin-glyph-bootstrap (launch-main-bootstrap-program)))

   211   ([script]

   212      (let [glyph-init (glyph-init-program relocated-bootstrap-start)

   213            main-glyph-start (+ relocated-bootstrap-start

   214                                    (count glyph-init))

   215            glyph-program (glyph-bootstrap-program

   216                           main-glyph-start 0 0)]

   217        (->> script

   218             (do-nothing 2)

   219             ;; begin glyph program

   220             (write-RAM 0xFF1A [0 0 0]) ;; silence remnant music

   221            

   222             (write-RAM

   223              relocated-bootstrap-start

   224              (concat glyph-init glyph-program))

   225             (transfer-control relocated-bootstrap-start)

   226             (do-nothing 1)

   227 

   228             ))))

   229 

   230 (defn write-all-program-data

   231   ([] (write-all-program-data (begin-glyph-bootstrap)))

   232   ([script]

   233      (let [base-address main-program-base-address]

   234        (->> script

   235             (write-RAM base-address (program-data base-address))))))

   236 

   237 (defn activate-program

   238   ([] (activate-program (write-all-program-data)))

   239   ([script]

   240      (->> script

   241           (transfer-control main-program-base-address)

   242           ;;(do-nothing 1800)

   243           (do-nothing 50)

   244           )))

   245 

   246 

   247 ;; possible screen writing programs

   248 

   249 ;; (program needs to stop executing at some point)

   250 ;; maybe have total length counter or something?

   251 

   252 ;; automatic counter that reads from program-start and clears the

   253 ;; screen every 360 (* 18 20) gliphs

   254 

   255 ;; advantages -- very simple and low bandwidth

   256 ;; disadvantages -- hard to align counter

   257 

   258 ;; implementation -- refactor main-bootstrap-program to provide a

   259 ;; state-machine code-section which can be recombined into another

   260 ;; program.
author	Robert McIntyre <rlm@mit.edu>
date	Fri, 31 Aug 2012 01:48:31 -0500
parents	2d9bf762a073
children	cd54ac4a8701