Mercurial > vba-clojure

comparison clojure/com/aurellem/run/image.clj @ 508:e6c02264dc9c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
trying to track down pesky assembly bug.
author Robert McIntyre <rlm@mit.edu>
date Wed, 20 Jun 2012 21:41:38 -0500
parents 24b459a95b46
children d2c40a12de28
comparison
equal deleted inserted replaced
507:24b459a95b46 508:e6c02264dc9c
425 (vec 425 (vec
426 (flatten 426 (flatten
427 (map row->bits 427 (map row->bits
428 (partition 8 tile)))))) 428 (partition 8 tile))))))
429 429
430 430
431 431 (defn write-data
432 (defn display-image-kernel [^BufferedImage image] 432 "Efficient assembly to write a sequence of values to
433 memory, starting at a target address."
434 [base-address target-address data]
435 (let [len (count data)]
436 (flatten
437 (if (<= len 255)
438 [0x21 ;; load data address start into HL
439 (reverse (disect-bytes-2 (+ 16 base-address)))
440
441 0x01 ;; load target address into BC
442 (reverse (disect-bytes-2 target-address))
443
444 0x16 ;; load len into D
445 len
446
447
448 ;; data x-fer loop start
449 0x2A ;; (HL) -> A; HL++;
450 0x02 ;; A -> (BC);
451 0x03 ;; INC BC;
452 0x15 ;; DEC D
453
454 0x20 ;; if D is not now 0,
455 (->signed-8-bit -6) ;; GOTO start
456
457 0x18
458 len
459
460 data]
461 (let [first-part (write-data base-address target-address
462 (take 255 data))]
463 [first-part
464 (write-data (+ base-address (count first-part))
465 (+ target-address 255)
466 (drop 255 data))])))))
467
468 (defn test-write-data []
469 (let [test-data (repeat 3 0xD3)
470 base-address 0xA000
471 target-address 0xA500
472
473 test-kernel
474 (flatten
475 [0xF3 ;; disable interrupts
476 (write-data (+ 1 base-address)
477 target-address test-data)
478 (infinite-loop)])]
479 ;; (assert
480 ;; (= test-data
481 (-> (mid-game)
482 tick tick tick
483 (set-memory-range base-address test-kernel)
484 (PC! base-address)
485
486 ;;(run-moves (repeat 100 []))
487 ;;(memory)
488 ;;vec
489 ;;(subvec target-address
490 ;; (+ target-address
491 ;; (count test-data)))
492 ;;println
493 )))
494
495
496
497
498
499
500
501 (defn display-image-kernel [base-address ^BufferedImage image]
433 (let [gb-image (image->gb-image image)] 502 (let [gb-image (image->gb-image image)]
434 503
435 [(clear-music-registers) 504 [(clear-music-registers)
436 505
437 ;; [ ] disable LCD protection circuit. 506 ;; [ ] disable LCD protection circuit.
453 522
454 ;; [ ] write minimum amount of tiles to BG character 523 ;; [ ] write minimum amount of tiles to BG character
455 ;; section 524 ;; section
456 525
457 526
458
459 ;; [ ] disable the display of OBJ tiles. 527 ;; [ ] disable the display of OBJ tiles.
460 528
461 529
462 ;; [ ] reactivate the LCD display 530 ;; [ ] reactivate the LCD display
463 531
464 532
465 (infinite-loop) 533 (infinite-loop)]
466 534
467 535
468 ) 536 ))
469 537
470 538
471 539