;z80
;zx-spectrum
;assembler

;Drum machine
tempo   equ 3;tempo of music

;entry point
enter   xor a
        ld (edop),a
posa    ld a,1
        ld (musstk),sp
        dec a
        jp z,kalknot;new note
        ld (posa+1),a
player
        ld bc,0
base_a  equ $-2
        ld sp,0
sampl_a equ $-2
ssaka   pop hl
        ld a,h
        cp #40
        jr nz,okey
        ld a,(lopdwa)
        add a,l
        cp 16
        jr c,$+4
        ld a,#f
        ld (lopdwa),a

        pop hl
        ld sp,hl
        jr ssaka
okey    add hl,bc
        ld de,#ffbf
        ld bc,#fffd
        xor a
        out (c),a
        ld b,e
        out (c),l
        inc a
        ld b,d
        out (c),a
        ld b,e
        out (c),h
        pop de
        ld a,e
        rlca
        and 1
        ld h,a
        ld a,e
        rrca
        rrca
        and %00001000
        ld (ziro+1),a
        jr nz,ziro+2
        ld a,e
        and #1f
        ld l,6
        ld b,#ff
        out (c),l
        ld b,#bf
        out (c),a
ziro    ld a,0
        or h
        ld (mixer+1),a
        ld a,d
        ld (sampl_a),sp
        ld l,8
        ld b,#ff
        out (c),l
        ld b,#bf
        sub 0
lopdwa  equ $-1
        ld e,a
        sbc a,a:cpl
        and e
        out (c),a
        ld bc,0
base_b  equ $-2
        ld sp,0
sampl_b equ $-2
makaka  pop hl
        ld a,h
        cp #40
        jr nz,okei
        ld a,(lopdwb)
        add a,l
        cp 16
        jr c,$+4
        ld a,#f
        ld (lopdwb),a
        pop hl
        ld sp,hl
        jr makaka
okei    add hl,bc
        ld de,#ffbf
        ld bc,#fffd
        ld a,2
        out (c),a
        ld b,e
        out (c),l
        inc a
        ld b,d
        out (c),a
        ld b,e
        out (c),h
        pop de
        ld a,e
        rlca
        rlca
        and 2
        ld h,a
        ld a,e
        rrca
        and %00010000
        ld (nulx+1),a
        jr nz,nulx+2
        ld a,e
        and %00011111
        ld l,6
        ld b,#ff
        out (c),l
        ld b,#bf
        out (c),a
nulx    ld a,0
        or h
mixer   or 0
        or %00100000
        ld h,7
        ld b,#ff
        out (c),h
        ld b,#bf
        out (c),a
        ld a,d
        ld (sampl_b),sp
        ld l,9
        ld b,#ff
        out (c),l
        ld b,#bf
        sub 0
lopdwb  equ $-1
        ld e,a
        sbc a,a:cpl:and e
        out (c),a
        ld sp,0
musstk  equ $-2
        ret
kalknot ld hl,0
       inc hl
        ld (kalknot+1),hl
cheknote ld a,1
        dec a
        ld (cheknote+1),a
        ld a,tempo
        ld (posa+1),a
        jr nz,pokus
        xor a
        ld (lopdwa),a
newnote ld sp,chanala
newpat  pop de
        ld a,e
        or a
        jr z,endpatt
        ld (cheknote+1),a
        ld (newnote+1),sp
        ld a,d
        and #f
        ld c,a:ld b,0
        ld hl,notes:add hl,bc
        ld sp,hl
        pop hl
        ld (base_a),hl
        xor d
        rrca
        rrca
        rrca
        ld c,a:ld hl,samplez
        add hl,bc
        ld sp,hl:pop hl
        ld (sampl_a),hl
pokus   ld a,1
        dec a
        ld (pokus+1),a
        jp nz,player
        ld (lopdwb),a
        ld sp,chanalb3
newpab  pop de
        ld (newpab-2),sp
        ld a,e
        ld (pokus+1),a
        ld a,d
        and #e
        ld hl,notes
        ld c,a
        ld b,0
        add hl,bc
        ld sp,hl
        pop hl
        ld (base_b),hl
        xor d
        rrca
        rrca
        rrca
        ld hl,samplez
        ld c,a
        ld b,0
        add hl,bc
        ld sp,hl
        pop hl
        ld (sampl_b),hl
        jp player
endpatt ld a,#ff
        ld (edop),a
        ld sp,patbtab
pbpb    equ $-2
        pop hl
        ld (pbpb),sp
        ld (newpab-2),hl
        ld sp,patatab
papa    equ $-2
        pop hl
        ld (papa),sp
        ld sp,hl
        jp newpat
edop    db 0
aytab   dw 0,0,427
        db 0,32
        db 0,0,#1d
        db #50,0,12
;patterns for channel a
patatab dw chanala,chanala1,chanala1
        dw chanala2,chanala2,chanala2
        dw chanala2
        dw chanala2,chanala2,chanala2
        dw chanala2
        dw chanala4,chanala4,chanala4
        dw chanala4
        dw chanala4,chanala4,chanala4
        dw chanala4
        dw chanala5,chanala5,chanala5
        dw chanala5
        dw chanala5,chanala5,chanala5
        dw chanala5
        dw chanala6,chanala6,chanala6
        dw chanala6
        dw chanala6,chanala6,chanala6
        dw chanala6
        dw chanala6,chanala6,chanala6
        dw chanala6
        dw chanala6,chanala6,chanala6
        dw chanala6
        dw chanala7,chanala7,chanala7
        dw chanala7
        dw chanala7,chanala7,chanala7
        dw chanala7,chanala8

;patterns for channel b
patbtab dw chanalb3,chanalb3,chanalb3
        dw chanalb3,chanalb3,chanalb3
        dw chanalb3
        dw chanalb3,chanalb3,chanalb3
        dw chanalb3
        dw chanalb3,chanalb3,chanalb3
        dw chanalb3
        dw chanalb3,chanalb3,chanalb3
        dw chanalb3
        dw chanalb5,chanalb5,chanalb5
        dw chanalb5
        dw chanalb5,chanalb5,chanalb5
        dw chanalb5
        dw chanalb3,chanalb3,chanalb3
        dw chanalb3
        dw chanalb3,chanalb3,chanalb3
        dw chanalb3
        dw chanalb3,chanalb3,chanalb3
        dw chanalb3
        dw chanalb3,chanalb3,chanalb3
        dw chanalb3
        dw chanalb7,chanalb7,chanalb7
        dw chanalb7
        dw chanalb7,chanalb7,chanalb7
        dw chanalb7,chanalb8

notes   dw 927,427,14
samplez dw n2,n3,n8,nf,nil
chanala db 32,#32,0
nil     dw 0:db #a0,0
        dw #4000,nil
;patterns
chanala1 db 8,#32,8,#32,8,#32,1,#32
         db 1,#32,1,#32,1,#32,1,#32
         db 1,#32,1,#32,1,#32,0
chanala2 db 8,#32,8,#32,8,#32,8,#32,0
chanala4 db 4,#32,4,#32,6,#12,2,#32
         db 4,#32,4,#32,4,#12,4,#12
         db 4,#32,4,#32,6,#12,4,#32
         db 2,#12,4,#32,4,#12,2,#32
         db 2,#32,0
chanala5 db 4,#32,2,#14,2,#14,4,#32
         db 2,#14,2,#14,4,#32,2,#14
         db 2,#14,4,#32,2,#32,2,#32,0
chanala6 db 4,#30,4,#14,4,#14,4,#12
         db 4,#12,4,#14,4,#12,4,#32,0
chanala7 db 16,#32,6,#32,2,#32,6,#32
         db 2,#32,0
chanala8 db 4,#32,4,#32,2,#32,1,#32
         db 1,#32,1,#32,1,#32,1,#32
         db 1+(16*15),#32,0
chanalb3 db 2,#04,2,#04,2,#04,2,#04
         db 2,#04,2,#04,2,#04,2,#04
         db 2,#04,2,#04,2,#04,2,#04
         db 2,#04,2,#04,2,#04,2,#04
         db 2,#04,2,#04,2,#04,2,#04
         db 2,#04,2,#04,2,#04,2,#04
         db 2,#04,2,#04,2,#04,2,#04
         db 2,#04,2,#04,2,#04,2,#04
chanalb5 db 32,#24
chanalb7 db 8,#04,2,#14,6,#04,8,#04,8,4
chanalb8 db 2,#04,8,#04,8+(16*15),#04
;samples
n2      dw #ffff:db %00000001,#c
smloop1 dw #0000:db %10000000,#c
        dw #4001,smloop1
n3      dw #ffff:db %00000000,#d
smloop2 dw #0000:db %10000000,#d
        dw #0000:db %10000000,#d
        dw #4001,smloop2
n8      dw #0000:db %00100000,#f
        dw #0000:db %00100000,#f
petelq1 dw #0000:db %00100000,#f
        dw #0000:db %00100000,#f
        dw #0000:db %00100000,#f
        dw #0000:db %00100000,#f
        dw #4001,petelq1
nf      dw #0080:db %00100000,#f
        dw #0100:db %00100000,#f
        dw #0180:db %00100000,#f
        dw #0200:db %00100000,#f
        dw #0280:db %00100000,#f
bochl   dw #0300:db %00100000,#e
        dw #0380:db %00100000,#d
        dw #0400:db %00100000,#d
        dw #0480:db %00100000,#d
        dw #4001, bochl 

;additional code
page    db 0

;chunky output decrunchers
;hl-chunky buffer address
_louti  ld a,-scr_l
        jr _cout0
_couti  xor a
_cout0  ex af:call pag7:ex af
        ld (info4+1),a:ld de,bufmov
        ld hl,info2:ld bc,info3-info2
        ldir:ld (pohuj+1),de
        ld a,scr_l/4
_cout1  ld c,info4-info3:ld hl,info3
        ldir:dec a:jr nz,_cout1:dec de
        ld c,info5-info4:ldir:ret

;divide: de=(de)dib(bc),hl=(de)mod(bc)
div16   ld hl,0:ld a,16
div1    rl e:rl d:adc hl,hl:sbc hl,bc
        jr nc,$+3:add hl,bc:ccf:dec a
        jr nz,div1:rl e:rl d:ret

;-multicolor subroutines
;change color palette
palette ld bc,templin
pal     push bc
secam   push hl:ld a,(bc):add a,l:ld l,a
        adc a,h:sub l:ld h,a:ld a,(hl)
        add a,a:add a,a:add a,a:ld xh,a
        inc bc:pop hl:push hl:ld a,(bc)
        add a,l:ld l,a:adc a,h:sub l
        ld h,a:ld a,(hl):and 7:or xh
        ld (de),a:inc de:inc bc:pop hl
        ld a,e:and 63:jr nz,secam
        pop bc:inc c:bit 0,c:jr nz,pal
        ld a,c:add a,#7e:ld c,a:adc a,b
        sub e:ld b,a:jr nz,pal:ret

;credits text messages
text    db 1:dw #4089
 db "V"*2,"I"*2,"R"*2,"T"*2,"U"*2
 db "A"*2,"L"*2
 db 1:dw #40Cd
 db "A"*2,"N"*2,"D"*2
 db 1:dw #480b
 db "T"*2,"I"*2,"G"*2,"R"*2,"R"*2
 DB 1:DW #484C
 DB "F"*2,"R"*2,"O"*2,"M"*2,1
 DW #4883
 DB "B"*2,"R"*2,"A"*2,"I"*2,"N"*2
 db "W"*2,"A"*2,"V"*2,"E"*2,"/"*2,"X"*2
 db "P"*2,"A"*2,1
 DW #48C0
 DB "P"*2,"R"*2,"E"*2,"S"*2,"E"*2,"N"*2
 db "T"*2," "*2,"4"*2,"K"*2," "*2,"I"*2
 db "N"*2,"T"*2,"R"*2,"O"*2,1
 DW #500A
 DB "C"*2,"A"*2,"L"*2,"L"*2,"E"*2,"D"*2
 db 1
 DW #504A
 DB "M"*2,"A"*2,"R"*2,"A"*2,"Z"*2,"M"*2
 db 0

;set addresses of lines beginning
proc    ld (kewlstek+1),sp
sine1   ld de,0
sine2   ld bc,0:ld h,sinetabs/256:exx
        ld a,#0
crd_y   equ $-1:add a,a:ld l,a
sprait  ld h,0:ld sp,hl
sporhl  ld hl,tadr_spr:ld c,#0
crd_x   equ $-1:ld xh,48
loop    exx:ld a,e:add a,d:ld e,a:ld a,c
        add a,b:ld c,a:ld l,a:ld a,(hl)
        ld l,e:add a,(hl):exx:add a,c
        pop de:srl a:ld b,a:sbc a,a
        and 64:or b:or e:ld b,d
        ld e,(hl):inc l; inc hl
        ld d,(hl):inc l; inc hl
        ld (de),a:inc de:ld a,b
        ld (de),a:dec xh:jp nz,loop
kewlstek ld sp,0:ret
;packed border color table
cltabdcr db #41,#09,#49,#42,#0a,#4a
         db #43,#0b,#4b,#44,#0c,#4c
         db #45,#0d,#54,#62

;inner loop for multicolor
multik0 ld (mimsp),sp
        ld hl,bordercl
        ld bc,#7ffd
        ld de,#171f
        exx
multik1 exx
        ld a,(hl):inc hl:out (#fe),a
mirok   out (c),e:ld (0),bc:nop
        exx
multik2 ld sp,0
        ld hl,0
        ld de,#5802
multik3 pop bc
        ld a,c
        xor (hl)
        ld (de),a
        inc l
        inc e
        ld a,b
        xor (hl)
        ld (de),a
multik4 inc l:inc e
multik5 exx:ld a,(hl):out (254),a:out (c),e:ld b,pousa
myslf   djnz myslf
        xor a:out (#fe),a:ld sp,(mimsp):ret
multik6

;inner loop for output attributs to
;the sides of screen
polos   ld (mimsp),sp
        ld sp,bordercl+1
poloski pop bc
        ld l,b
        ld h,b
mukmak  ld (0),hl
        ld (0),hl
        ld (0),hl
        ld l,c
        ld h,c
        ld (0),hl
        ld (0),hl
        ld (0),hl
polos1  ld sp,(mimsp)
        ret
polos2
mimsp  dw 0
;sinusoidal perversion table
;dx,x,dy,y,da,a,sa,db,b,sb
pervert db 3,0, -2,46, 6,5,-3, -1,66,4
        db -2,160, 3,0, -7,70,6, 4,77,3
perver0 db 5,0, -4,0, 0,0,0, 0,0,0
        db 4,0, -3,64, 0,0,0, 0,0,0
perver1 db 5,5, 2,70, -5,4,3, 5,5,-6
        db 2,100, -3,6, 4,0,8, 3,67,-5
perver2 db 3,3, 4,2, 2,18,-2, 2,5,-5
        db -3,50, 3,3, -4,0,6, -3,2,3
;set palette
colrtb1 db #8,9,11,15,10,12,14,13;¤<ï 1 á¯à câ 
colrtb2 db 0,0,7,3,4,3,7,0;¤<ï 2 á¯à câ 
colrtb3 db 11,14,12,15,9,12,15,13
colrtb4 db 1,5,7,7,5,3,0,0
colrtb5 db 1,7,5,6,2,2,6,2
;palete table
palitra dw colrtb2,colrtb2,perver0
        dw colrtb1,colrtb2,pervert
        dw colrtb3,colrtb5,perver1
        dw colrtb4,colrtb5,perver2
;pages for storing of kardioida
pages   db #10,#11,#13

pag7    ld a,#17
        jr lkl
pag6    ld a,#16
        jr lkl
pag4    ld a,#14
        jr lkl
pag3    ld a,#13
        jr lkl
pag1    ld a,#11
        jr lkl
pag0    ld a,#10
;change RAM page
lkl     push bc
        ld (page),a
        or 0
screen  equ $-1
        ld bc,#7ffd
        out (c),a
        pop bc
        ret

;inner loop of tonnel
toninf  ld de,c_buf:ld a,32
        ld (257+tonin3-tonin2+tonnel+tonin1-toninf),sp
        ld sp,ofs
tonin1  pop hl:add hl,bc:ldi
tonin2  dec a:jp nz,tonin1-toninf+tonnel
tonin3  ld sp,0:ret
tonin4
;inner loop for voxels
info0   exx
        inc c
        inc h
        exx
        inc e
blah    ld  a,(bc)
        inc c
        add a,d
        or #c0
        ld d,a
        ld a,(de)
        inc e
        exx
        add a,c
        ld l,a
        ld a,b
        sub (hl)
        jr nc,2*scr_h+$+popsa-mizda+5
        ld b,(hl)
        add a,d
info1   jp voxel1

;inner loop of slow chunky output
;not enough memory :-(
info2   ld (outc_sp),sp:ld sp,hl
        ld xh,scr_h:ld b,chuky/256
info3   pop hl:ld c,(hl):ld a,(bc)
        ld (de),a:inc b:inc d:ld a,(bc)
        ld (de),a:inc b:inc d:ld a,(bc)
        ld (de),a:inc b:inc d:ld a,(bc)
        ld (de),a:inc e
        pop hl:ld c,(hl):ld a,(bc)
        ld (de),a:dec b:dec d:ld a,(bc)
        ld (de),a:dec b:dec d:ld a,(bc)
        ld (de),a:dec b:dec d:ld a,(bc)
        ld (de),a:inc e
info4   ld hl,0:add hl,sp:ld sp,hl
        dec e:ld a,e:and #e0:ld e,a
        ld a,d:add a,4:ld d,a:and 7
        jr nz,nihuq:ld a,e:add a,32
        ld e,a:jr c,nihuq:ld a,d
        sub 8:ld d,a
nihuq   dec xh
pohuj   jp nz,$:ld sp,(outc_sp):ret
info5

;chunky images
c_ob    dw #aa08,#aaaa,#ffbe,#ffff
        dw #0000,#5544,#5555,#ffdd
        dw #2a02,#aaaa,#bfab,#ffff
        dw #0000,#1501,#5555,#7f57
outc_sp dw 0;stack 4 chunky output
;data for voxel decrunching
voxel1  inc bc
        inc l
        ld de,0
voxadr  equ $-2
        bit 0,l
        jr nz,vxd
        inc d
        ld a,d
        or #c0
        ld d,a
        ld (voxadr),de
vxd     exx
        dec xh
        jr nz,voxel2
        ret

;fast (but not very fast) perspective
;voxel output by Virtual/Brainwave
voxel   ld xh,scr_l
        ld (voxadr),de
        ld bc,offsets
        ld l,chunky\256
        exx
        ld d,#40
voxel2  ld hl,y_tab
        ld b,l;y0
        ld c,xl
        exx
        ld h,chunky/256+scr_h-1
        ld a,(de)
        inc e
        exx
        add a,c
        ld l,a
        ld a,(hl);y_tab
        or a
        jr z,scr_h*2+popsa+1
        ld b,a
        cpl
        add a,scr_h*2+1
mizda   ld (jmr+1),a
        exx
        ld a,(de)
jmr     jr$
popsa   ld (hl),a:dec h