;  Critter - For the Bally Arcade / Astrocade
;  By Brett Bilbrey
;  ARCADIAN 3, no. 2 (Dec. 05, 1980): 13. [No explanation]
;  CURSOR 2, no. 3 (October 1980):66-67.  [With Explanation]
;
;  This Z80 source is based on what appears in the PEEK N' POKE
;  manual.  It been changed so that it runs under AstroBASIC and
;  assembles under Zmac.  The Z80 code it generates is the same as
;  the BASIC listings that appear in the Arcadian and the Cursor
;  newsletters except that the interrupt routine location has been
;  changed from the Bally BASIC routine to the AstroBASIC routine. 
;
;  When assembled this program will NOT run as a cartridge as the
;  program is meant to be run in AstroBASIC.  The BASIC version of
;  "Critter" can be found after the source code at the end of
;  this file.
;
;  To assemble this Z-80 source code using ZMAC:
;  
;  zmac -d -o <outfile> -x <listfile> <filename>
;  
;  For example, assemble this Astrocade Z-80 ROM file:
;
;  zmac -i -m -o crit2000.bin -x crit2000.lst crit2000.asm
;
;
; Revisions:
;     Version 1.51 (December 7, 2011)
;        - General notes added
;        - Original Bally BASIC Interrupt Routine added as a comment 
;     Version 1.5  (July 28, 2011)
;        - Added comments
;        - Added standard names as used in the HVBLIB.H
;     Version 1.4  (March 2, 2011)
;        - Modified for AstroBASIC
;     Version 1.3  (February 12, 2002)


INCLUDE "HVGLIB.H"

        ORG    $4C80

        DI
        EXX
        LD     A,$4C
        LD     I,A          ; Load I with page of interrupt vector
        LD     A,$E0
        OUT    ($0D),A      ; Load custom chips with line of
        EXX                 ; interrupt vector
        EI
        RET

        ORG    $4CE0

        DW     $4CE3        ; Points to interrupt routine
       
        ORG    $4CE3

; Interrupt Routine - 
;        CALL   $20B0        ; Call Bally BASIC interrupt routine 
        CALL   $21FD        ; Call AstroBASIC interrupt routine
               
        DI
        LD     ($4C70),SP   ; Save SP
        LD     SP,$4C70     ; Move SP

        PUSH   AF
        PUSH   BC
        PUSH   DE
        PUSH   HL
        PUSH   IX
        PUSH   IY

        IN     A,(POT0)     ; Get KN(1) value
        LD     (TIMBAS),A   ; Place in vector block

        SYSTEM (INTPC)      ; Begin Interpreting

        DO     (MCALL)
        DW     VWRITE       ; Call V Write Routine

        DO     VECT         ; Vector Object in Two Dimensions
        DW     VBLOCK       ; Vector Block Address
        DW     LIMITS       ; Limit Table

        DO     (MCALL)
        DW     VWRITE       ; Call V Write Routine

        EXIT                ; Exit Interpreter

        POP    IY
        POP    IX
        POP    HL
        POP    DE
        POP    BC
        POP    AF
        LD     SP,($4C70)   ; Return SP
        EI
        RET

        ORG    $4D18
VWRITE: DO     (VWRITR)     ; Write Relative From Vector
        DW     VBLOCK       ; Vector
        DW     PATERN       ; Pattern
        DONT   MRET         ; Return from Interpretive Subroutine

        ORG    $4D20
; Limit Table

LIMITS: DB     0,152        ; X boundaries
        DB     0,64         ; Y boundaries

; Critter Pattern
; Color 0 = White and Color 2 = Black
;
PATERN: DB     0,0      ; (0,0) Position
        DB     $02,$08  ; 2 byte, 8 line pattern size

        DB     $0A,$A0  ; 0000101010100000 - . . 2 2 2 2 . .  
        DB     $22,$88  ; 0010001010001000 - . 2 . 2 2 . 2 .
        DB     $AA,$AA  ; 1010101010101010 - 2 2 2 2 2 2 2 2
        DB     $2A,$A8  ; 0010101010101000 - . 2 2 2 2 2 2 .
        DB     $08,$20  ; 0000100000100000 - . . 2 . . 2 . .
        DB     $20,$08  ; 0010000000001000 - . 2 . . . . 2 .
        DB     $08,$20  ; 0000100000100000 - . . 2 . . 2 . .
        DB     $00,$00  ; 0000000000000000 - . . . . . . . .

; VECTOR BLOCK (See 'Nutting' ROM Manual, page 39-41)
VBLOCK: DB     $20     ; Magic Register Value
        DB     $80     ; Vector Status - High Bit set to "Active"
TIMBAS: DB     $00     ; Time Base - Holds KN(1) value
        DW     $0005   ; Delta X
        DW     $0000   ; X Position
        DB     $03     ; X Checks Mask -Bounce off walls
        DW     $0005   ; Delta Y
        DW     $0000   ; Y Position
        DB     $03     ; Y Checks Mask -Bounce off walls

END    ; Assembler stops assembling program here

Here is "Critter" in BASIC with the changes needed to run the program in 
AstroBASIC.  This code can be copied and pasted into a file and then run 
through the utilities txt2prg, then through KCS.  Both of these utilities can
be downloaded from www.ballyalley.com.  This will create a 300-Baud 
program.  Finally, this program can be loaded as a 300-BAUD file using the "300 
Baud to 2000 Baud Tape Converter."  You DON'T need the 300-Baud interface to do 
any of this.  Here is the program:

  10 clear ;&(15)=99
  20 A=19584;B=A;C=640
  30 D=-9741;gosub C
  40 D=19518;gosub C
  50 D=18413;gosub C
  60 D=-8130;gosub C
  70 D=3539;gosub C
  80 D=-1063;gosub C
  90 D=201;gosub C
 100 A=19680
 110 D=19683;gosub C
 120 A=19683
 130 D=-563;gosub C
 140 D=-3295;gosub C
 150 D=29677;gosub C
 160 D=19568;gosub C
 170 D=28721;gosub C
 180 D=-2740;gosub C
 190 D=-10811;gosub C
 200 D=-8731;gosub C
 210 D=-539;gosub C
 220 D=-9243;gosub C
 230 D=12828;gosub C
 240 D=19770;gosub C
 250 D=255;gosub C
 260 D=6151;gosub C
 270 D=16205;gosub C
 280 D=19768;gosub C
 290 D=19744;gosub C
 300 D=6151;gosub C
 310 D=589;gosub C
 320 D=-7683;gosub C
 330 D=-7715;gosub C
 340 D=-11807;gosub C
 350 D=-3647;gosub C
 360 D=31725;gosub C
 370 D=19568;gosub C
 380 D=-13829;gosub C
 390 A=19736
 400 D=14367;gosub C
 410 D=9293;gosub C
 420 D=2125;gosub C
 430 A=19744
 440 D=-26624;gosub C
 450 D=16384;gosub C
 460 D=0;gosub C
 470 D=2050;gosub C
 480 D=-24566;gosub C
 490 D=-30685;gosub C
 500 D=-21846;gosub C
 510 D=-22486;gosub C
 520 D=8200;gosub C
 530 D=2080;gosub C
 540 D=8200;gosub C
 550 D=0;gosub C
 560 D=-32735;gosub C
 570 D=1280;gosub C
 580 D=0;gosub C
 590 D=768;gosub C
 600 D=5;gosub C
 610 D=0;gosub C
 620 D=3;gosub C
 630 CALL B;STOP
 640 %(A)=D;A=A+2;return

Happy programming!
