; Dots tunnel, version 3: the v2 now clears only the bytes it has lit.
; The tables come from the file that the BASIC program saved.
; rasm tunnel-v3.asm -o tunnel-v3 writes tunnel-v3.sna.

        buildsna
        bankset 0

YLO = #4000                     ; the memory map of tables.bas
YHI = #4100
CENTER = #4200
SHAPE = #4A00
LIST_C0 = #7C00                 ; the lit bytes in the #C000 screen
LIST_80 = #7E00                 ; and in the #8000 screen
RINGS = 16
DOTS = 16

; Gate Array colours (#40 + hardware colour number)
BLACK = #54
BLUE = #44
SKY_BLUE = #57
BRIGHT_WHITE = #4B
RED = #4C

        macro border,colour
        ld bc,#7F10             ; Gate Array: select the border
        out (c),c
        ld a,{colour}
        out (c),a
        mend

        org YLO
        incbin "TABLES.BIN",128         ; skip the 128-byte AMSDOS header

        org #1000
        run start

start:  di
        ld sp,#1000
        call init
        ld hl,LIST_C0
        ld a,#C0
        call fill_list
        ld hl,LIST_80
        ld a,#80
        call fill_list

main:   call wait_vbl
        ld a,(back)
        call show_screen        ; show the screen we have just drawn
        ld a,(back)
        xor #40                 ; #C0 <-> #80
        ld (back),a             ; and draw into the other one
        ld a,(erase_list)
        xor #02                 ; #7C <-> #7E: the list follows the screen
        ld (erase_list),a

        border RED              ; work starts

        ld a,(erase_list)       ; clear the bytes lit two pictures earlier
        ld h,a
        ld l,0
        push hl
        push hl
        pop iy                  ; IY walks through the list
        ld b,0                  ; 256 addresses
erase:  ld l,(iy+0)
        ld h,(iy+1)
        ld (hl),0
        inc iy
        inc iy
        djnz erase
        pop iy                  ; plot rewrites the list from the start

        ld hl,t
        inc (hl)
        ld a,(hl)
        neg
        and 63
        ld (depth),a            ; ring 0: d = -t and 63

        ld a,RINGS
        ld (ring),a
ring_loop:
        call ring_setup         ; ringX, ringY, pen, and IX = SHAPE of the ring
        ld a,DOTS
        ld (dot),a
dot_loop:
        ld a,(ringX)
        add a,(ix+0)            ; x = ringX + dx
        ld b,a
        ld a,(ringY)
        add a,(ix+1)            ; y = ringY + dy
        ld c,a
        ld a,(pen)
        ld e,a
        call plot
        inc ix
        inc ix
        ld hl,dot
        dec (hl)
        jr nz,dot_loop

        ld a,(depth)            ; next ring: d + 4
        add a,4
        and 63
        ld (depth),a
        ld hl,ring
        dec (hl)
        jr nz,ring_loop

        border BLACK            ; work ends
        jp main

; ring_setup: read the centre, the ink and the shape address of ring d.
ring_setup:
        ld a,(depth)
        ld c,a
        and #3C                 ; (d >> 2) * 4
        ld l,a
        ld h,0
        add hl,hl
        add hl,hl
        add hl,hl
        add hl,hl
        add hl,hl               ; (d >> 2) * 128
        ld a,(t)
        add a,c
        and #FC
        rrca                    ; phase * 2, phase = ((t + d) >> 2) and 63
        or l
        ld l,a
        ld a,h
        add a,CENTER>>8
        ld h,a
        ld a,(hl)
        ld (ringX),a
        inc hl
        ld a,(hl)
        ld (ringY),a

        ld a,c                  ; pen = PENS(d >> 4)
        rlca
        rlca
        rlca
        rlca
        and 3
        ld e,a
        ld d,0
        ld hl,PENS
        add hl,de
        ld a,(hl)
        ld (pen),a

        ld a,(t)                ; IX = SHAPE + d * 128 + rot * 32
        and #0C
        rlca
        rlca
        rlca                    ; rot * 32, rot = (t >> 2) and 3
        ld e,a
        ld a,c
        srl a                   ; A = d >> 1, carry = d and 1
        jr nc,even_depth
        set 7,e                 ; + 128 if d is odd
even_depth:
        add a,SHAPE>>8
        ld d,a
        push de
        pop ix
        ret

; plot: set pixel (B, C) with ink E (4 pixels of the same ink).
plot:   ld a,b
        and 3                   ; place of the pixel in its byte
        ld d,#88                ; bits of the left pixel
        jr z,mask_ink
next_pixel:
        srl d
        dec a
        jr nz,next_pixel
mask_ink:
        ld a,d
        and e
        ld e,a                  ; bits of the pixel, in the ink

        ld a,b
        srl a
        srl a                   ; byte column: x >> 2
        ld h,YLO>>8
        ld l,c
        add a,(hl)              ; + low byte of the line
        ld b,a
        inc h                   ; YHI = YLO + 256
        ld a,(back)
        adc a,(hl)              ; + high byte, carry and screen start
        ld h,a
        ld l,b
        ld a,e
        or (hl)                 ; keep the other pixels of the byte
        ld (hl),a
        ld (iy+0),l             ; record the address for the clearing
        ld (iy+1),h
        inc iy
        inc iy
        ret

; init: mode 1, ROMs off, palette.
init:   ld bc,#7F8D
        out (c),c
        ld hl,palette
        ld e,0
next_ink:
        out (c),e               ; E < #10: select ink E
        ld a,(hl)
        out (c),a               ; #40 to #5F: set its colour
        inc hl
        inc e
        ld a,e
        cp 4
        jr nz,next_ink
        ld a,#10                ; select the border
        out (c),a
        ld a,BLACK
        out (c),a
        ret

; fill_list: fill list HL with 256 copies of the address A * 256, the first
; byte of a screen that is still black: the first clearing changes nothing.
fill_list:
        ld b,0
next_entry:
        ld (hl),0
        inc hl
        ld (hl),a
        inc hl
        djnz next_entry
        ret

; show_screen: the CRTC will show the screen whose high byte is A (#C0 or #80),
; from the next picture on.
show_screen:
        ld bc,#BC0C             ; CRTC: select register 12
        out (c),c
        rrca
        rrca
        and #30                 ; #C0 -> #30, #80 -> #20
        inc b                   ; #BD: write to the register
        out (c),a
        ret

; wait_vbl: wait for the start of the frame flyback.
wait_vbl:
        ld b,#F5                ; PPI port B, bit 0 = VBL
vbl_end:
        in a,(c)
        rra
        jr c,vbl_end            ; already in the VBL: wait for its end
vbl_start:
        in a,(c)
        rra
        jr nc,vbl_start
        ret

palette:
        db BLACK,BLUE,SKY_BLUE,BRIGHT_WHITE
PENS:   db #FF,#0F,#F0,#F0      ; 4 pixels of ink 3, 2, 1, 1 for d >> 4

back:   db #C0                  ; high byte of the work screen
erase_list: db LIST_C0>>8       ; high byte of its list
t:      db 0
depth:  db 0
ring:   db 0
dot:    db 0
ringX:  db 0
ringY:  db 0
pen:    db 0