;z80
;zx-spectrum
;assembler

;MARAZM 4Kb intro by Virtual and Tigrr
;from Brainwave of X-Project Association
;1st place at CAFe'99 demoparty

;Constants
intersp equ #5c00
inttab  equ #be00
;voxels
depth   equ 32;depth
scr_h   equ 32;screen height
scr_l   equ 64;~ len
eye     equ 16;scale factor
v_map   equ #c000;voxel map address
y_tab   equ inttab-(depth*256);scaling table
chunky  equ inttab-(scr_h*256)+192;chunky buffer
offsets equ chunky/256*256-(depth*scr_l);offsets table
tabhead equ offsets-(depth*2);table for head moving
citytab equ tabhead/256-1*256;horiz. moving
motalka equ citytab/256-1*256;vert. moving
headup  equ motalka-256
sinus   equ #5d00;sinus signed table
kvtab   equ sinus-256;square table
;tunnel constants
walls   equ #c000;wall texture
arcsin  equ inttab-256;arcsine table
arccos  equ arcsin-256;arccosine table
ofs     equ arccos-#1000;offset table
tonnel  equ ofs-512;tonnel output
ofscopy equ tonnel-#1100;copy of offsets
c_buf   equ ofscopy-#800;chunky buffer
sinetxt equ c_buf-256;sine texture
buf4lin equ sinetxt-256;buffer for line
tonsin  equ buf4lin-256;texture sinus
vrsin   equ tonsin-256;rotate  table
y0      equ 16;parameters
x0      equ 32;of the
l0      equ 32;rectangle
h0      equ 16;tunnel
scale   equ 16;
kvadtun equ #c000;offsets for rect. tonnel
;kardioida's constants
otrtab  equ inttab-#500
kardrad equ 28;radius
kardx   equ 80;x0
kardy   equ 75;y0
k_out   equ #8000;kardioidal output
cardsin equ k_out/256-1*256;sinus table
;page 7
bufmov  equ #fd00;chunky to scr
chuky   equ bufmov-#400;chunky images
chuk_p  equ chuky-#1000;chunky pointer
color   equ chuk_p/256+15;color
;multicolors
speed   equ 3;border speed
pousa   equ 66;pause
sprite1 equ #7e00;1st sprite
sprite2 equ sprite1+#2000;2nd sprite
sinetabs equ sprite1-256; moving
sin22amp equ sinetabs-256;
sin40amp equ sin22amp-256;tables
brdsin   equ sin40amp-256;
linbegin equ brdsin-512;something..
tadr_spr equ linbegin-256;~
bordercl equ tadr_spr-256;border colours
tablik   equ #5b00;border colours
wywodil equ #db00;multicolor
kraya   equ #fd00;border of screen
templin equ #e000;temporary line

        di
        ld (exitsp),sp
        call fillscr
;ay initialize
        ld hl,aytab
        ld c,#fd
        xor a
ayini   ld b,#ff:out (c),a:ld b,#bf:outi
        inc a:cp 14:jr c,ayini

;sine generation by Virtual
 ld hl,sintab-1:ld de,sinus:ld bc,#06fa
ins1 ld a,e:and 3:jr nz,$+3:inc hl
     xor a:rlc (hl):rla:rlc (hl):rla
     dec a:add a,b:ld b,a:add a,c
     ld c,a:call inssr:push de:ld a,(de)
     ex af:ld a,128:sub e:ld e,a:ex af
     call inssr:pop de:inc e:ld a,e
     cp #41:jr c,ins1
;square table
     call pag6:ld sp,kvtab+256
     ld hl,127*127:ld bc,-253
kvad push hl:add hl,bc:inc bc:inc bc
     jr c,kvad:ld sp,(exitsp)
;multicolor picture generation
 ld hl,templin:exx:ld c,64
intrf1 ld b,128
intrf2 ld l,c:dec l:sla l
     ld h,kvtab/256:ld e,(hl):inc l
     ld d,(hl):ld a,b:sub 64:jr nc,$+4
     neg:add a,a:ld l,a:ld h,kvtab/256:ld a,(hl):inc l
     ld h,(hl):ld l,a:add hl,de:push bc
     call sqr:pop bc:rrca:and 7:exx
     ld (hl),a:inc hl:exx:djnz intrf2
     dec c:jr nz,intrf1
;credits part
 ld hl,text
tpr1 ld a,(hl):inc hl:or a:jr z,tex
     cp 1:jr nz,tpr2
     ld e,(hl):inc hl:ld d,(hl):inc hl
     jr tpr1
tpr2 push hl:push de:rlca:rlca
 ld b,a:and #f8:ld c,a:xor b:add a,#3c
 ld b,a:ld xh,8
tpr3 ld a,(bc):ld l,a:srl a:or l:inc c
     ld xl,8
tpr4 rlca:adc hl,hl:rrca:adc hl,hl:rlca
     dec xl:jr nz,tpr4:ex de,hl
     ld (hl),d:inc l:ld (hl),e:inc h
     ld (hl),e:dec l:ld (hl),d:ex de,hl
     call dnde:dec xh:jr nz,tpr3
     pop de:inc e:inc e:pop hl:jr tpr1
tex
;interrupt table
 ld hl,inttab:ld de,inttab+1:ld b,e:ld c,l:ld a,h:ld i,a:inc a:ld (hl),a:im 2:ldir:ld a,#c3:ld (inttab/256+inttab+257),a
 ld hl,imob:ld (inttab/256+inttab+258),hl:ei

;tonnel part
;create arcsine
 ld de,arcsin:ld h,sinus/256
darcs ld bc,#ff00:ld l,c
darcs1 ld a,e:sub (hl):jr nc,$+4:neg
 cp b:jr nc,$+4:ld b,a:ld c,l:inc l
 bit 6,l:jr z,darcs1:ld a,c:srl a
 ld (de),a:xor #1f:inc a:dec d:ld (de),a
 inc d:inc e:jr nz,darcs
;create offsets
 call pag0:ld c,32:ld hl,ofs
c_ofs push bc
      ld a,c:ld (quest+1),a:ld a,16
      sub c:jr nc,$+4:neg:ld yh,a
      add a,a:ex de,hl:ld l,a
      ld h,kvtab/256:ld a,(hl):inc l
      ld h,(hl):ld l,a:ld (c_ofs2+1),hl
      ex de,hl:ld b,64
c_ofs1 push bc:ld xh,b:push hl:ld a,32
       sub b:jr nc,$+4:neg:ld xl,a
       add a,a:ld l,a:ld h,kvtab/256
       ld e,(hl):inc l:ld d,(hl)
c_ofs2 ld hl,0:add hl,de:call sqr:or a
      jr nz,$+3:inc a:ld c,a:ld de,#8000
      call div16:ld a,e:and #80:ld e,a
      ld a,d:and #1f:ld d,a:push de
      ld e,b:ld a,yh:cp xl:jr nc,c_ofs3
      ld d,a:call div16:ld h,arcsin/256
      jr c_ofs4
c_ofs3 ld d,xl:call div16
       ld h,arccos/256
c_ofs4 ld l,e:ld a,xh:cp 32:ld a,(hl)
       jr nc,$+4:xor 63:ld l,a
quest  ld a,0:cp 16:ld a,l:jr nc,$+4
       xor 63:pop hl:add a,l:ld l,a
qwer   ld bc,0:add hl,bc:inc bc
       ld (qwer+1),bc:ex de,hl:pop hl
       ld (hl),e:inc hl:ld (hl),d:inc hl
       pop bc:dec b:jp nz,c_ofs1:pop bc
       dec c:jp nz,c_ofs

;rectangle tunnel
    call pag3:ld h,kvadtun/256:ld yh,32
kv0 ld a,yh:sub 16:jr nc,kv1:neg:inc a
kv1 ld yl,a:ld xh,64
kv2 push hl:ld a,xh:sub 32:jr nc,kv3
    neg:inc a
kv3 ld xl,a:ld a,yl:add a,a:cp xl
    jr c,vertic:ld c,yl:ld de,y0*scale
    ld b,e:call div16:push de:ld b,d
    ld c,e:ld de,2*l0*scale:call div16
    ld h,a:ld b,d:ld c,e:ld a,c:rra
    add a,32:sub xh:add a,a:ld l,a
    add hl,hl:add hl,hl:add hl,hl
    add hl,hl:ex de,hl:call div16
    ld a,e:add a,16:ld b,a:jr nemka
vertic ld c,xl:ld de,x0*scale:ld b,e
    call div16:push de:ld b,d:ld c,e
    ld de,h0*scale:call div16:ld h,a
    ld b,d:ld c,e:ld a,yl:add a,a
    add a,a:add a,a:ld l,a:add hl,hl
    ex de,hl:call div16
    ld a,xh:cp 33:ld a,e:jr nc,$+4
    xor 63:ld b,a
nemka pop de:ld a,e:and #3f:rrca:ld d,a
      and 128:ld e,a:xor d:ld h,a:ld a,e
      add a,b:ld l,a
Kuchma ld bc,0:add hl,bc:inc bc
       ld (Kuchma+1),bc:ex de,hl:pop hl
       ld (hl),e:inc hl:ld (hl),d:inc hl
       dec xh:jp nz,kv2:dec yh:jp nz,kv0
;decrunch chunky routines & data
 call pag7
;chunky images by Megus/BW
        ld hl,c_ob:ld de,#5b00:ld b,32
        ld a,(hl):rld:ld (de),a:inc de
        ld a,(hl):rld:ld (de),a:inc de
        inc hl:djnz $-11:ld h,d:ld l,b
        ld e,b:ld bc,chuky
L1      ld a,(de):xor (hl):and 15
        xor (hl):ld (bc),a:inc bc:inc l
        ld a,l:and 15:jr nz,L1:inc e
        ld a,e:and #f0:ld l,a:sub #40
        jr nz,L1
;create chunky pointers table
 ld h,chuk_p/256:ld d,h
i_c_ptr ld b,16:ld l,d
i_c_pt1 ld (hl),a:inc a:inc l
        djnz i_c_pt1:inc h:or a
        jr nz,i_c_ptr
;create chunky output
        call _couti
;Voxel map calculating
 call pag1
 ld bc,v_map
i_map ld a,b:add a,a:add a,a:push af
      ld l,a:ld a,c:add a,a:add a,a
      push af:add a,l:ld l,a
      ld h,sinus/256:ld e,(hl):inc h
      ld d,(hl):ex de,hl:add hl,hl
      add hl,hl:ex de,hl:pop hl:pop af
      sub h:ld l,a:ld h,sinus/256
      ld a,(hl):inc h:ld h,(hl):ld l,a
      add hl,hl:add hl,hl:add hl,de
      ld a,c:rrca:rrca:rrca:add a,b
      and 31:cp 16:jr c,$+4:xor 31
      sub 8:add a,h:and #fe:add a,48
      ld (bc),a:sub 32:srl a
      add a,chuk_p/256:inc c:ld (bc),a
     inc c:jr nz,i_map:inc b:jr nz,i_map
;rendering texture for tunnel
 call pag0:ld hl,buf4lin
rbfl ld a,l:add a,a:add a,a:ld b,7
     call bsina:add a,chuk_p/256+8
     ld (hl),a:inc l:jr nz,rbfl
     ld h,tonsin/256:ld bc,#8080
     call izsin:ld de,walls
dwal ld hl,tonsin
iwal equ $-2:ld a,l:add a,4:ld (iwal),a
     ld l,(hl):ld h,buf4lin/256:ld b,128
zwal1 ld a,(hl):inc l:ld (de),a:inc de
      djnz zwal1:inc d:dec d:jr nz,dwal

      call dtunnel;depack tunnel
;wait begining of the tunnel part
      ld de,32*4-3
kiki call cheknot
 jr c,kiki
 ld a,#5f:call cls:ld de,12*32-8
 call tunpart;tunnel part

;--voxels
 call _louti;create output
;create offsets
 ld bc,offsets:ld xl,scr_l
i_offs1 ld a,scr_l/2:sub xl:ld l,a
        sbc a ,a:ld h,a:add hl,hl
        add hl,hl:add hl,hl:add hl,hl
        ld d,h:ld e,l:ld xh,depth
i_offs2 ld a,h:add hl,de:sub h:neg
      ld (bc),a:inc bc:dec xh
      jr nz,i_offs2:dec xl:jr nz,i_offs1
;create scaling table
      ld xh,depth:ld bc,y_tab
i_ytb0 push bc:ld de,eye*512:ld b,e
       ld a,eye+depth:sub xh:ld c,a
       call div16:ld l,48:call mul16
       ld a,h:cpl:ld h,a:ld a,l:cpl
       ld l,a:inc hl:pop bc:ld xl,170
i_ytb1 ld a,h:add a,scr_h:jp p,i_ytb2
       xor a:ld (bc),a:add hl,de:inc c
       dec xl:jr nz,i_ytb1
i_ytb2 ld a,h:add a,scr_h:cp 65:jr c,$+4
       ld a,64:and #fe:ld (bc),a:inc c
       add hl,de:dec xl:jr nz,i_ytb2
       ld c,0:inc b:dec xh:jr nz,i_ytb0
;-decrunch inner loop
 ld hl,popsa:ld de,popsa+2:ld bc,2*31
 ldir:ld hl,info0:ld c,info1-info0:ldir
 ld hl,mizda
 ld bc,0+(info1-info0+popsa-mizda+64)*(depth-1)-info1+blah-1
 ldir
 ld hl,info1
 ld c,info2-info1
 ldir
;decrunch address table
 ld hl,mizda+1:ld de,jmr+1
 ld bc,info1-info0+popsa-mizda+(scr_h*2)
 ld a,depth
d_vxl ld (hl),e:inc hl:ld (hl),d:dec hl
      add hl,bc:ex de,hl:add hl,bc
      ex de,hl:dec a:jr nz,d_vxl
;moving tables
 ld bc,#1408:ld h,motalka/256:call izsin
 ld bc,#1025:dec h:call izsin
;create head tab
 halt:ld sp,tabhead+(depth-1*2)
 ld de,-(info1-info0+popsa-mizda+(scr_h*2))
 ld hl,scr_h*2+popsa+1+(info1-info0+popsa-mizda+(scr_h*2)*31)
 ld b,31
crh push hl:add hl,de:djnz crh
    ld sp,(exitsp)
;flying over the mountains
 call w_edop;wait end of pattern
 ld a,#16:call cls
moun call pag1:call razmah:push hl
     call clvxl:pop de:ld a,d:add a,12
     or #c0:ld h,a:ld l,e:ld bc,#0820
gethgt ld a,c:cp (hl):jr nc,$+3
       ld a,(hl):ld c,a:ld a,h:inc a
       or #c0:ld h,a:djnz gethgt:ld a,38
       sub c:jr c,$+3:xor a:ld xl,a
       push de:push ix:call dizing
       pop ix:pop de:call voxel
       ld hl,chunky:call putbuf
       ld de,20*32-8:call cheknot
       jr c,moun
;create city
 call pag1:ld hl,v_map:ld (hl),32:inc hl
 inc hl:inc h:dec h:jr nz,$-6
;buildings
dom call rnd:rrca:and 12:ld h,a:ld l,0
domy equ $-1
 call rnd:rlca:rlca:and 5:add a,8:ld b,a
 call rnd:rrca:and 6:add a,10:ld c,a
 call rnd:and 28:add a,50:call build
 ld hl,domy:call rnd:and 6:add a,7
 add a,(hl):ld (hl),a:jp p,dom
;-road
 ld hl,v_map+#2400:ld b,20
road1 inc l:ld (hl),color-15:inc l
      jr nz,road1:inc h:djnz road1
      ld a,h:sub 10:ld h,a
road2 inc l:bit 3,l:jr nz,$+8
      ld (hl),color-6:dec h
      ld (hl),color-6:inc h:inc l
      jr nz,road2
;-flying tables
 ld h,citytab/256:ld bc,#05fb:call izsin
 dec h:ld bc,#0a1f:call izsin
 dec h:ld c,#25:call izsin
;--city part
 call w_edop:ld a,#4f:call cls
city call pag1:call clvxl:ld hl,citytab
cps equ $-2
 ld a,(hl):ld xl,a:ld a,l:add a,4
 ld (cps),a:ld d,32:push ix:call dizing
 pop ix:call razmah:ex de,hl:call voxel
 ld hl,chunky:call putbuf:ld de,28*32-5
 call cheknot:jr c,city
;rectange tunel
 call pag3
 ld hl,kvadtun:ld de,ofs:ld bc,#1000
 ldir:call dtunnel:call _couti
 ld a,#5e:call cls:ld de,36*32-40
 call tunpart

;multicolor part
        call fillscr
        ld h,sinetabs/256
        ld bc,#800
        call izsin
        dec h
        ld bc,#1626
        call izsin
        dec h
        ld bc,#2828
        call izsin
        dec h
        ld bc,#1516
        call izsin

        call pag6
;create border lines
declr ld hl,cltabdcr
 ld de,tablik:ld bc,tablik+5:exx:ld b,16
declr1 exx:ld a,(hl):and 7:ld (de),a
       ld (bc),a:xor (hl):rrca:rrca:rrca
       ld (hl),a:and 7:ex de,hl
       add a,(hl):inc l:ld (hl),a
       dec c:ld (bc),a:ex de,hl
       ld a,(hl):rrca:rrca:rrca:and 3
       ex de,hl:add a,(hl):ex de,hl
       inc e:dec c:ld (de),a:ld (bc),a
       ld a,e:add a,4:ld e,a:add a,5
       ld c,a:inc hl:exx:djnz declr1

        call pag7
;decrunch inner loop
 ld hl,multik0:ld de,wywodil
 ld bc,multik1-multik0:ldir:ld xh,48
strok   ld hl,multik1
        ld bc,multik5-multik1:ldir
        ld a,12
stroka  ld hl,multik3
        ld c,multik5-multik3:ldir
        dec a:jr nz,stroka:dec de:dec de
        ld hl,mirok+1:ld a,(hl)
        xor 8:ld (hl),a
        ld hl,(multik3-2)
        ld b,#80:ld a,h:rrca:rrca:and 32
      ld c,a:add hl,bc:ld (multik3-2),hl
        dec xh:jr nz,strok
        ld hl,multik5
        ld bc,multik6-multik5:ldir
;calculate addresses
 halt
 ld hl,multik5-multik3*13+multik3-multik1-2*47+wywodil+multik2-multik0+1
 ld sp,tadr_spr+96+128
 ld b,48
 ld de,-(multik5-multik3*13+multik3-multik1-2)
adrcl push hl:add hl,de:djnz adrcl
 ld hl,multik5-multik3*13+multik3-multik1-2*47+wywodil+multik2-multik0+4
 ld sp,tadr_spr+96:ld b,48
adrchl  push hl:add hl,de:djnz adrchl
;create addresses of lines
        ld sp,linbegin+512 ;1-c á¯à câ
        ld hl,sprite2:ld de,#80:ld c,2
dspr    ld b,64:push hl:add hl,de
        djnz $-2:ld b,64:sbc hl,de
        push hl:djnz $-3:ld hl,sprite1
        dec c:jr nz,dspr:ld sp,(exitsp)
;screen filling
        ld  hl,#57ff
filsc   ld (hl),#f:dec hl:bit 6,h
        jr nz,filsc
;drawing sine of screen
 ld hl,#401c:ld c,0
sin_    push hl
ssin    ld a,0:add a,5:ld (ssin+1),a
        ld b,4:call bsina:ld d,a
sin__   ld a,0:add a,-7:ld (sin__+1),a
        call bsina:add a,d:add a,8
        ld de,0:ld bc,0:ex de,hl
        jr z,sin0_:add hl,hl:inc l
        dec a:jr nz,$-3
sin0_   ex de,hl:dec a:ld (hl),d:inc hl
        ld (hl),e:inc hl:ld (hl),a
        inc hl:ld (hl),a:ld a,l:sub 31
        ld l,a:ld a,d:cpl:ld (hl),a
        inc hl:ld a,e:cpl:ld (hl),a
        pop de:call dnde:ex de,hl
        ld a,h:cp #58:jr c,sin_
;lines on the sides of screen
        ld hl,polos:ld de,kraya
        ld bc,polos1-polos:ldir:push hl
        ld hl,kraya+poloski-polos
        ld bc,polos1-poloski*23:ldir
        pop hl:ld c,polos2-polos1:ldir
        ld hl,kraya+mukmak-polos+1
        ld de,#d800:ld b,24
d_polos push de:ld (hl),e:inc hl
        ld (hl),d:inc hl:inc hl
        ld a,e:add a,28:ld (hl),a
        inc hl:ld (hl),d:inc hl
        inc hl:inc a:inc a:ld (hl),a
        inc hl:ld (hl),d:inc hl:inc hl
        inc hl:inc hl:pop de:res 7,d
        ld (hl),e:inc hl:ld (hl),d
        inc hl:inc hl:ld a,e:add a,28
        ld (hl),a:inc hl:ld (hl),d
        inc hl:inc hl:inc a:inc a
        ld (hl),a:inc hl:ld (hl),d
        inc hl:inc hl:inc hl:inc hl
        inc hl:ld e,a:inc de:inc de
        set 7,d:djnz d_polos
;create palette
        ld hl,palitra:ld b,4
multi   push bc:push hl:halt
        ld de,#5aff:xor a:ld (de),a
        dec de:bit 3,d:jr nz,$-4
        push hl:call movscr:pop hl
        halt:ld (mimi+1),sp:ld sp,hl
        pop hl:pop de:pop bc
mimi    ld sp,0:ld (perversion),bc
        push de:call pag6:ld de,sprite1
        call palette:pop hl:call palette
        call pag7:halt:call w_edop
        ld a,#c9:ld (#bfbf),a
        ld bc,288
null    push bc
        xor a:out (#fe),a
        ld (bordercl),a
        ld (dihalt+1),sp:ld h,a:ld l,a
        ld b,48/2:ld sp,bordercl+49
        push hl:djnz $-1
zaza    ld sp,tablik:ld h,bordercl/256
        ld xl,16
craza   ld a,0:ld (crazy0+1),a
crazy0  ld de,brdsin:ld a,e:add a,8
        ld (crazy0+1),a:ld a,(de):ld l,a
  pop bc:ld (hl),c:inc l:ld (hl),b:inc l
  pop bc:ld (hl),c:inc l:ld (hl),b:inc l
  pop bc:ld (hl),c:inc l:ld (hl),b:inc l
        dec xl:jr nz,crazy0
        ld hl,craza+1:ld a,(hl)
        add a,speed:ld (hl),a
dihalt  ld sp,0
        call kraya;lines on screen

       ld a,linbegin/256:ld (sprait+1),a
       ld hl,tadr_spr:ld (sporhl+1),hl
;sine perversions
       ld hl,pervert
perversion equ $-2:ld b,2
pilot0  push bc
        ld a,(hl);dx
        inc hl:add a,(hl)
        ld (hl),a;x=x+dx
        inc hl
        ld e,a
        ld d,sin22amp/256
        ld a,(de)
        ld (crd_x),a

        ld a,(hl);dy
        inc hl
        add a,(hl)
        ld (hl),a;y=y+dy
        inc hl
        ld e,a
        dec d
        ld a,(de)
        ld (crd_y),a
        ld a,(hl)
        inc hl
        ld e,(hl)
        add a,e
        ld a,b
        dec a
        jr z,$+4;wait interrupt
        ei:halt
        ld (hl),a
        inc hl
        ld d,(hl)
        inc hl
        ld (sine1+1),de

        ld a,(hl)
        inc hl
        ld e,(hl)
        add a,e
        ld (hl),a
        inc hl
        ld d,(hl)
        inc hl
        ld (sine2+1),de
        push hl
        call proc;set addresses
        ld a,linbegin/256+1
        ld (sprait+1),a
        ld hl,tadr_spr+#80
        ld (sporhl+1),hl
        pop hl
        pop bc
        djnz  pilot0
        call wywodil;create multicolor
        call enter;drum machine
        pop bc
        dec bc
        ld a,b
        or c
        jp nz,null
        ld a,#c3
        ld (#bfbf),a
        ei
        pop hl
        inc hl
        inc hl
        inc hl
        inc hl
        inc hl
        inc hl
        pop bc
        dec b
        jp nz,multi

;calculating of the Kardioida
;create tables for horiz. lines
        ld hl,otrtab
        ld de,#4000
iotr1   ld (hl),d
        inc h
        ld (hl),e
        dec h
        call dnde
        inc l
        jr nz,iotr1
        ld d,otrtab/256+2
        ld h,e
        ld b,e
        ld c,32
iotrt1  ld a,h
        ld (de),a
        add hl,bc
        inc e
        jr nz,iotrt1
        inc d
        ld a,#ff
iotrt2  ld (de),a
        srl a
        jr nz,$+3
        cpl
        inc e
        jr nz,iotrt2
        inc d
iotrt3  xor a
iotrt4  scf
        rra
        ld (de),a
        jr c,iotrt3
        inc e
        jr nz,iotrt4
        call pag0
        call fillscr
;draw kardioida
;x=x0+r*sin(alfa)
;y=y0-r*cos(alfa)
;r=2*r*sin(alfa/2)
;circle x,y,r
        xor a
        ld (screen),a
linol push af:ld c,a
kard0 push bc:ld a,c:ld b,-kardrad
      call bsina:add a,kardx:ld l,a
      ld a,c:call bcosa:add a,kardy
      ld h,a:ld (crdc),hl:ld a,c:srl a
      ld b,kardrad*2:call bsina
      ld (radius),a:call krug:pop bc
      ld a,c:add a,16:ld c,a
      jr nc,kard0:ld hl,#ff00
;store current sprite
kadr equ $-2
    ld a,h:cp #f9:jr c,ncpag:ld de,pages
p_pos equ $-2
 ld a,(de):inc de:ld (p_pos),de:call lkl
 ld h,#c0
ncpag ld de,#4080:ld c,e
sohrsp push de:ld b,20
sohsp1 ld a,(de):ld (hl),a:xor a
 ld (de),a:inc e:inc hl:djnz sohsp1
 pop de:call dnde:dec c:jr nz,sohrsp
 ld (kadr),hl:pop af:add a,2:cp 32
 jr c,linol

;decrunch output of sprite
;inner loop: pop hl:ld (xx),hl
 ld hl,infk:ld de,k_out
 ld c,infk1-infk
 ldir:push hl:ex de,hl:ld de,#4086
 ld c,128
crkou0 ld b,10:ld a,e
crkou1 ld (hl),#e1:inc hl:ld (hl),#22
       inc hl:ld (hl),e:inc hl:ld (hl),d
       inc hl:inc e:inc e:djnz crkou1
       ld e,a:call dnde:dec c
       jr nz,crkou0:ex de,hl
       pop hl:ld c,infk2-infk1:ldir

 ld h,cardsin/256:ld bc,#8036:call izsin
 ld a,#7:call cls
;Kardioidal part
draw halt
draw1 ld hl,cardsin:ld a,(hl):inc l
      ld (draw1+1),hl:and 15:ld e,a
      ld d,0:ld bc,6:call div16:ld c,l
      ld hl,pages:add hl,de:ld a,c
      add a,a:add a,a:add a,c:add a,a
      or #c0:ld d,a:ld a,(hl):call lkl
      ex de,hl:ld l,0:call k_out
      ld de,61*32:call cheknot:jr c,draw
      call fillscr
exit    di
outofp  xor a   ;ay shut
        ld l,a
gluh1   ld bc,#fffd
        out (c),a
        ld b,#bf
        out (c),l
        dec a
        jr nz,gluh1

        call pag0
        in a,(#fb)
        ld hl,(#3ffe)
        ld de,"T"*256+"E"
        sbc hl,de
        jr nz,$
        rst 0
;interrupt subroutine
imob    ex (sp),hl
        ld (imjp+1),hl
        ex (sp),hl
        inc sp
        inc sp
        ld (imsp+1),sp
        ld sp,intersp
        push af:push bc:push de:push hl
        exx:ex af:push af:push bc
        push de:push hl:push ix:push iy
        jp bacalka
obradr  equ $-2
isr     call enter;drum mashine
        ld a,#7f
        in a,(254)
        rrca
        jr c,isrend
        ld sp,0
exitsp  equ $-2
        jr exit

isrend  pop iy:pop ix
 pop hl:pop de:pop bc:pop af:ex af:exx
 pop hl:pop de:pop bc:pop af

imsp    ld sp,0
        ei
imjp    jp$

;restore hl
rest_hl ld de,(intersp-8)
        ld hl,(imsp+1)
        dec hl
        ld (hl),d
        dec hl
        ld (hl),e
        jr isr
;restore from table
resttab ld hl,(imsp+1)
        dec hl:dec hl
        ld a,h
        cp ofs/256:jr c,rest_hl
        cp arccos/256:jr nc,rest_hl
        ex de,hl
        ld l,e:sub ofs-ofscopy/256
        ld h,a
        ldi
        ldi
        jr isr
;restore bc
rest_bc ld hl,(imsp+1)
        ld de,(intersp-4)
        dec hl:ld (hl),d:dec hl:ld (hl),e
        jr isr
;checking note
cheknot ld hl,(kalknot+1)
        or a
        sbc hl,de
        ret

;output for credits part
bacalka ld a,(kalknot+1):and 15
        jr nz,isr:ld a,(posa+1):dec a
        jr nz,isr
kij     ld hl,#5880:ld d,h:ld e,l
        inc de:ld (hl),#47
        ld bc,63:ldir:ld (kij+1),de
        jr isr
;wait end of pattern
w_edop  ld a,(edop):or a:jr z,w_edop:ret

;tunnel part
tunpart ld hl,resttab
 ld (obradr),hl
 call w_edop
ton1 push de:call pag0
 ld hl,walls
inside equ $-2
 ld de,128
 add hl,de
 res 5,h
 ld (inside),hl
 ld de,vrsin
rtadr equ $-2
 ld a,e:inc a:ld (rtadr),a
 ld a,(de):and 63:add a,l:ld c,a:ld b,h
 call tonnel
 ld hl,c_buf:call putbuf:pop de
 call cheknot:jr c,ton1
 ld hl,rest_hl
 ld (obradr),hl
 ret
;decrunch tunnel
dtunnel ld hl,vrsin:ld bc,#4000
        call izsin
;decrunch inner loop
 ld hl,toninf:ld de,tonnel
 ld bc,tonin1-toninf
 ldir:push de:ld c,tonin2-tonin1
 ldir:pop hl:ld c,tonin2-tonin1*63:ldir
 ld hl,tonin2:ld c,tonin4-tonin2:ldir
 ld hl,ofs:ld de,ofscopy:ld b,#10:ldir
 ret

;autopilot over the voxel map
razmah ld hl,motalka
sinadr equ $-2
 ld a,(hl):or #c0:ld h,a:ld a,l:add a,6
smesh equ $-1:ld (sinadr),a:ret

;control altitude
dizing ld hl,headup
headpos equ $-2
 ld d,(hl):ld a,l:add a,8:ld (headpos),a
 ld a,xl:or a:jp p,dizzy:add a,d
 jr c,dizzy
 xor a:sub xl:ld d,a
dizzy   ld (diz2+1),sp
        ld a,d
        sub 32
        ld e,#0c;inc c
        jr nc,dizdn
        inc e;dec c
        neg
dizdn   ld d,a
        ld a,depth-1/2
        ld bc,depth-1*256
        ld sp,tabhead
diz1 pop hl:sub d:ld (hl),c:jr nc,$+5
     add a,31:ld (hl),e:djnz diz1
diz2 ld sp,0:ret

;clear chunky buffer for voxels
clvxl ld (tempsp),sp:ld hl,chunky+64
      ld de,chuk_p/256+chuk_p:ld b,scr_h
clsp0 ld sp,hl
 push de:push de:push de:push de
 push de:push de:push de:push de
 push de:push de:push de:push de
 push de:push de:push de:push de
 push de:push de:push de:push de
 push de:push de:push de:push de
 push de:push de:push de:push de
 push de:push de:push de:push de
 inc h
 djnz clsp0:ld sp,0
tempsp equ $-2
 ret

;draw building
;hl-crds:b-hgt,c-len:a-hgt
build sla l:ld e,b:push hl:call buil0
 pop hl:inc h:dec c:dec c
buil1 push hl:set 7,h:set 6,h:ld (hl),a:inc l:ld (hl),color-1:inc l:ld b,e:dec b
buil2 ld (hl),a:inc l:ld (hl),color-4:inc l:djnz buil2:pop hl:inc h:dec c:jr nz,buil1
 ld b,e
buil0 set 7,h:set 6,h:ld (hl),a:inc l:ld (hl),color-4:inc l:djnz buil0
 ret
;create sine table
;hl-sinus tab (zsinus)
;b-ampl,c-x0
;(hl)=b*sin(l)+c
izsin   ld l,0
izs1    ld a,l:call bsina:add a,c
        ld (hl),a:inc l:jr nz,izs1:ret

;output chunky buffer to screen
putbuf  ld de,#4080
        ld bc,screen
        ld a,(bc)
        xor 8
        ld (bc),a
        jr nz,$+4
        ld d,#c0
        halt
        call pag7
        jp bufmov
;clear screen
fillscr xor a
        out (254),a
cls;    a-color
        ld b,0
        ld hl,#5aff
        ld (hl),b
        dec hl
        bit 6,h
        jr nz,$-4
        ld hl,#5880
        ld (hl),a
        inc l
        ld (hl),a
        inc hl
        djnz $-4
;copy screen to 7th page
movscr  ld a,(page)
        ex af
        call pag7
        ld hl,#5aff
        ld de,#daff
        ld bc,#1b00
        lddr
        ex af
        jp lkl
;data for sine table
sintab  db #58,#56,#15,#55
        db #49,#21,#85,#52
        db #21,#54,#88,#54
        db #85,#52,#15,#48,#55
inssr   ld (de),a
        set 7,e
        neg
        ld (de),a
        inc d
        sbc a,a
        ld (de),a
        res 7,e
        xor a
        ld (de),a
        dec d
        ret
;calculate random number
rnd     ld a,37
seed    equ $-1
        push hl
        inc a
        ld l,a
        add a,a
        add a,a
        add a,a
        add a,l
        add a,a
        add a,a
        add a,a
        add a,l
        ld (seed),a
        pop hl
        ret
;filled circle (xor put)
krug    ld      hl,(crdc)
        ld      (kruge+1),hl
        ex      de,hl
        ld      hl,0
radius  equ     $-2
        inc     l
        dec     l
        ret     z
        ld      a,e
        sub     l
        ld      b,a
        ld      a,e
        add     a,l
        ld      c,a
        push    de
        push    hl
        call    xorotr
        pop     hl
        pop     de
        ld      a,l
        cp      2
        jr      nc,krug4
        push    de
        dec     d
        ld      b,e
        ld      c,e
        call    xorotr
        pop     de
        inc     d
        jp      xorotr
krug4   ld      de,-1
        ld      b,h
        ld      c,l
        sla     c
        dec     hl
        exx
        ld      c,1
        ld      b,a
;main loop
krug6   exx
        add     hl,de
        dec     e
        dec     e
        jr      c,krugc
        dec     c
        dec     c
        add     hl,bc
        exx

        push    bc
        ld      de,#1020
crdc    equ     $-2
        dec     c

        ld      a,e
        ld      e,b
        push    de
        sub     c
        ld      b,a

        add     a,c
        add     a,c
        ld      c,a

        ld      a,d
        sub     e
        ld      d,a

        call    xorotr
        pop     DE
        ld      a,d
        add     a,e
        ld      d,a
        call    xorotr
        pop     bc
        dec     b
        exx
krugc   exx

        push    bc
kruge   ld      de,0

        ld      a,e
        ld      e,c
        add     a,b
        ld      c,a
        sub     b
        sub     b
        ld      b,a
        push    de
        ld      a,d
        sub     e
        ld      d,a
        call    xorotr
        pop     de
        ld      a,d
        add     a,e
        ld      d,a
        call    xorotr
        pop     bc
        inc     c
        ld      a,c
        cp      b
        jr      c,krug6
        ret     nz
        ld      de,(crdc)

        dec c
        ld a,e
        ld e,b
        push de
        sub c
        ld b,a

        add a,c
        add a,c
        ld c,a

        ld a,d
        sub e
        ld d,a
        call    xorotr
        pop de
        ld a,d
        add a,e
        ld d,a
;xor put horizontal line
xorotr  ld l,d
        ld h,otrtab/256
        ld d,(hl)
        inc h
        ld a,(hl)
        inc h
        ld l,b
        or (hl)
        ld e,a
        ld a,(hl)
        ld l,c
        sub (hl)
        inc h
        ld l,b
        jr nc,xorotr2
        cpl
        push bc
        ld b,a
        ld a,(de)
        xor (hl)
        ld (de),a
        inc e
        inc b
        dec b
        jr z,xoro1
xoro0   ld a,(de)
        cpl
        ld (de),a
        inc e
        djnz xoro0
xoro1   pop bc
        ld l,c
        inc h
        ld a,(de)
        xor (hl)
        ld (de),a
        ret
xorotr2 ld a,(hl)
        inc h
        ld l,c
        and (hl)
        ex  de,hl
        xor (hl)
        ld (hl),a
        ret
;a=b*cos(a)
bcosa   add a,64
;a=b*sin(a)
bsina   push bc:push de:push hl
        ld l,a
        ld h,sinus/256
        ld e,(hl)
        inc h
        ld d,(hl)
        ld a,b
        add a,a
        sbc a,a
        ld h,a
        ld l,b
        call mul16
        ld a,h
        rl l
        adc a,b
        pop hl:pop de:pop bc
        ret
;slow square root
;a=sqrt(hl)
sqr ld de,64:ld b,8
 ld a,l:ld l,h:ld h,d
sqr2 sbc hl,de:jr nc,$+3:add hl,de
 ccf:rl d:add a,a:adc hl,hl:add a,a
 adc hl,hl:djnz sqr2:ld a,d:ret
;multiply hl=hl*de
mul16   ld a,h
        ld c,l
        ld hl,0
        ld b,16
mul1    add hl,hl
        rl c
        rla
        jr nc,$+3
        add hl,de
        djnz mul1
        ret
;calculate address of downer line
dnde    inc     d
        ld      a,d
        and     7
        ret     nz
        ld      a,e
        add     a,32
        ld      e,a
        ret     c
        ld      a,d
        sub     8
        ld      d,a
        ret
infk    ld (k_out+#1400+infk1-infk+2),sp
        ld sp,hl
infk1   add hl,sp
        ld sp,0
        ret
infk2
        include "introadd";additional code
        ds 5;need