  ; coded by candman/cream
  ; 
  ; this is dedicated to jana :)
  ; 
  ; cream 2000
  ; 
  ; email: candyman@atari.org
  ; www:   cream.atari.org
  ; 
  ; this is my first efx on xl
  ; there are some optimisation
  ; possible but anyway this
  ; was just a test if i can
  ; handle 6502 code ;)
  ; ---------------------------
  ; 
  ; some macros
  ; 
  ; ---- move word
 MW:MAC 2
 LDA ?1
 STA ?2
 LDA ?1+1
 STA ?2+1
 END 
  ; ---- move immediate word
 miw:MAC 2
 LDA #<?1
 STA ?2
 LDA #>?1
 STA ?2+1
 END 
  ; ---- move immediate byte
 mib:MAC 2
 LDA #?1
 STA ?2
 END 
  ; ---- move byte
 mb:MAC 2
 LDA ?1
 STA ?2
 END 
  ; ---- test byte
 tst:MAC 2
 LDA ?2
 CMP #?1
 END 
  ; ---- inc zeropage word
 iw:MAC 1
 PHA 
 LDA ?1
 CMP #$FF
 BNE cont@
 INC ?1+1
 cont@:INC ?1
 PLA 
 END 
  ; ---- add immediate word
 aiw:MAC 2
 LDA ?2
 CLC 
 ADC #?1
 STA ?2
 BCC noi@
 INC ?2+1
 noi@:
 END 
  ; ----
 over0f:EQU $A800
 overf0:EQU $A900
 blobrout:EQU $AA00
 flar0f:EQU $7000
 flarf0:EQU flar0f+(80*80)
  ; ----
 bumpsrc:EQU $8000
 _A0:EQU $A0
 _A1:EQU $A2
 _A2:EQU $A4
 _a3:EQU $A6
 _A4:EQU $A8
 _A5:EQU $AA
 _a6:EQU $AC
 _d0:EQU $AE
 _d1:EQU $B0
 _d2:EQU $B2
 _d3:EQU $B4
 _d4:EQU $B6
 _d5:EQU $B8
 _d6:EQU $BA
 _d7:EQU $BC
 _d8:EQU $BE
 dlz:EQU $A0
 bumpl:EQU $A0
 bumpr:EQU $A2
 bumpu:EQU $A4
 bumpd:EQU $A6
 bump:EQU $A8
  ; ---------------------------------
  ; here we go
  ; ---------------------------------
 ORG $4000
 JSR initdl
 JSR initdl2
 JSR initOver
 JSR initFlar
 JSR genBRout
 JSR clrscr
 JSR vblOn
 .MB 623,old623
 .MIB $28,$D409
 .MIB $0,$D012
 .MIB $0,$D01A
 loop:
 LDA 540
 wait:
 CMP 540
 BEQ wait
 JSR doBlobs
 LDA d_flag
 EOR #1
 STA d_flag
 .TST $21,$D209
 BNE loop
 .MW olddl,$230
 .MB old623,623
 JSR vblOff
 RTS 
  ; ---------------------------------
 clrscr:
  ; clear screens and the end of the
  ; light map
 .MIW scr,_a0
 LDA #0
 LDX #0
 clr01:
 LDY #0
 clr02:
 STA (_a0),Y
 INY 
 BNE clr02
 INC _a0+1
 INX 
 CPX #$10
 BNE clr01
 .MIW $A200,_a0
 .MIW $A300,_a1
 .MIW $A400,_a2
 .MIW $A500,_a3
 LDA #0
 LDY #0
 clr03:
 STA (_a0),Y
 STA (_a1),Y
 STA (_a2),Y
 STA (_a3),Y
 INY 
 BNE clr03
 RTS 
  ; ---------------------------------
 genBRout:
  ; generate a routine from the
  ; blobtemp template
  ; it creates excatly one line
  ; which draws the blobs
 .MIW blobrout,_a0
 .MIB 0,_d0
 .MIB 0,_d1
  ; 
 LDX #37
 gen02:
 .MIW blobtemp,_a1
 LDA _d0
 STA bt1+1
 STA bt2+1
 CLC 
 ADC #$1
 STA bt3+1
 STA bt4+1
 CLC 
 ADC #$1
 STA _d0
  ; 
 LDA _d1
 STA bt5+1
 CLC 
 ADC #$1
 STA _d1
 LDY #blobtend-blobtemp
 gen01:
 LDA (_a1),Y
 STA (_a0),Y
 DEY 
 BPL gen01
 .AIW blobtend-blobtemp,_a0
 DEX 
 BNE gen02
 LDA #$60
 LDY #0
 STA (_a0),Y
 RTS 
  ; ----------------------------
  ; this template draws 2 pixel on
  ; screen...it is duplicated later
 blobtemp:
 bt1:LDY #0
 LDA (_a2),Y ; flar0f
 ORA (_a3),Y ; flarf0
 TAY 
 LDA (_a1),Y ; overf0
 bt2:LDY #0
 ORA (_a5),Y ; flar0f
 TAY 
 LDA (_a1),Y ; overf0
 STA _d0
  ; 
 bt3:LDY #0
 LDA (_a2),Y ; flar0f
 ORA (_a3),Y ; flarf0
 TAY 
 LDA (_a1),Y ; overf0
 bt4:LDY #0
 ORA (_a5),Y ; flar0f
 TAY 
 LDA (_a0),Y ; over0f
 ORA _d0
  ; 
 bt5:LDY #0
 STA (_a4),Y
 blobtend:
  ; ---------------------------------
 doBlobs:
  ; draw the screen with 3 blobs
 .MIW over0f,_a0
 .MIW overf0,_a1
 .MIW flar0f,_a2
 .MIW flarf0,_a3
  ; handle blob 1 movement
 .MIW 80,acc
 LDA #0
 STA aux+1
 LDA f_posy
 TAY 
 LDA sintab,Y
 CLC 
 ADC #45
 LSR  
 STA aux
 JSR mul
 LDA _a2
 CLC 
 ADC acc
 STA _a2
 LDA _a2+1
 CLC 
 ADC acc+1
 STA _a2+1
  ; 
 LDA f_posx
 TAY 
 LDA sintab,Y
 CLC 
 ADC #$45
 ADC _a2
 BCC db_adc1
 INC _a2+1
 db_adc1:
 STA _a2
  ; handle blob 2 movement
 .MIW 80,acc
 LDA #0
 STA aux+1
 LDA f_posy2
 TAY 
 LDA sintab,Y
 CLC 
 ADC #45
 LSR  
 STA aux
 JSR mul
 LDA _a3
 CLC 
 ADC acc
 STA _a3
 LDA _a3+1
 CLC 
 ADC acc+1
 STA _a3+1
  ; 
 LDA f_posx2
 TAY 
 LDA sintab,Y
 CLC 
 ADC #45
 ADC _a3
 BCC db_adc2
 INC _a3+1
 db_adc2:
 STA _a3
  ; handle blob 3 movement
 .MIW flar0f,_a5
 .MIW 80,acc
 LDA #0
 STA aux+1
 LDA f_posy3
 TAY 
 LDA sintab,Y
 CLC 
 ADC #45
 LSR  
 STA aux
 JSR mul
 LDA _a5
 CLC 
 ADC acc
 STA _a5
 LDA _a5+1
 CLC 
 ADC acc+1
 STA _a5+1
  ; 
 LDA f_posx3
 TAY 
 LDA sintab,Y
 CLC 
 ADC #45
 ADC _a5
 BCC db_adc3
 INC _a5+1
 db_adc3:
 STA _a5
  ; 
 .MIW scr,_a4
 LDA d_flag
 BEQ db_scr1
 .MIW scr+$800,_a4
 db_scr1:
 .MIB 0,_d1
 .MIB 0,_d4
 LDX #48
 db_01:
 JSR blobrout
 .AIW 80,_a2
 .AIW 80,_a3
 .AIW 80,_a5
 .AIW 40,_a4
 DEX 
 BNE db_01
 INC f_posx
 LDA f_posx
 CMP #sinend-sintab
 BCC db_no1
 .MIB 0,f_posx
 db_no1:
 INC f_posy
 LDA f_posy
 CMP #sinend-sintab
 BCC db_no1y
 .MIB 0,f_posy
 db_no1y:
 INC f_p2
 LDA f_p2
 CMP #$2
 BNE db_no2
 .MIB 0,f_p2
 INC f_posx2
 LDA f_posx2
 CMP #(sinend-sintab)
 BCC db_no2
 .MIB 0,f_posx2
 db_no2:
 INC f_posy2
 LDA f_posy2
 CMP #sinend-sintab
 BCC db_no1y2
 .MIB 0,f_posy2
 db_no1y2:
 INC f_posx3
 LDA f_posx3
 CMP #sinend-sintab
 BCC db_no3
 .MIB 0,f_posx3
 db_no3:
 INC f_posy3
 LDA f_posy3
 CMP #sinend-sintab
 BCC db_no1y3
 .MIB 0,f_posy3
 db_no1y3:
 .MIW dl,$230
 LDA d_flag
 BEQ db_scr2
 .MIW dl2,$230
 db_scr2:
 RTS 
 f_p2:DFB 0
 f_posx:DFB 0
 f_posy:DFB 8
 f_posx2:DFB 4
 f_posy2:DFB 20
 f_posx3:DFB 12
 f_posy3:DFB 16
 d_flag:DFB 0
  ; ---------------------------------
 initFlar:
  ; preshifs the flar by 4 bits
  ; this is later to avoid 4* asl
 .MIW flar0f,_a0
 .MIW flarf0,_a1
 LDY #0
 if_01:
 LDA (_a0),Y
 ASL  
 ASL  
 ASL  
 ASL  
 STA (_a1),Y
 .AIW 1,_a1
 .AIW 1,_a0
 LDA _a0
 CMP #<flarf0
 BNE if_01
 LDA _a0+1
 CMP #>flarf0
 BNE if_01
 RTS 
  ; ---------------------------------
 initOver:
  ; generates a table for the blobs
  ; it is later used to add 2 colors
  ; to one ...this is to avoid
  ; color overflows  the color must be
  ; <$f
 LDY #$0
 .MIB 0,_d0
 io_1:
 .MIB 0,_d1
 io_2:
 LDA _d0
 CLC 
 ADC _d1
 CMP #$F
 BCC io_no
 LDA #$F
 io_no:
 STA over0f,Y
 ASL  
 ASL  
 ASL  
 ASL  
 STA overf0,Y
 INY 
 INC _d1
 LDA _d1
 CMP #$10
 BNE io_2
 INC _d0
 LDA _d0
 CMP #$10
 BNE io_1
 RTS 
  ; ---------------------------------
 crbump:
  ; this is for later use
  ; this creates a bumpmap of a pic
  ; not finished yet
 .MIW bumpsrc-1,bumpl
 .MIW bumpsrc+1,bumpr
 .MIW bumpsrc-40,bumpu
 .MIW bumpsrc+40,bumpd
 .MIW $9000,bump
 LDY #$0
 crbl1:
 LDA (bumpl),Y
 CLC 
 SBC (bumpr),Y
 ASL  
 STA (bump),Y
 INY 
 BNE crbl1
 RTS 
 LDX #$0
  ; ----------------------------
 vblOn:
  ; inits the vbl....
 .MIB 0,$D40E
 .MW 546,oldvbl
 .MIW vbl,546
  ; 
 .MW $230,olddl
 .MIW dl,$230
 .MIB $40,$D01B
 .MIB $40,$D40E
 RTS 
 vblOff:
  ; deinits the vbl
 .MW oldvbl,546
 RTS 
 vbl:
 DEC 540
 .MW $230,$D402
 PLA 
 TAY 
 PLA 
 TAX 
 PLA 
 RTI 
 oldvbl:DFW 0
  ; ----------------------------
 initdl:
  ; this autogenerates the distplaylist
 .MIW dl,dlz
  ; 3*8 blank lines
 LDA #$70
 LDY #0
 STA (dlz),Y
 .IW dlz
 STA (dlz),Y
 .IW dlz
 STA (dlz),Y
 .IW dlz
 LDX #$30
 dl_loop:
 LDA #$4F
 STA (dlz),Y
 .IW dlz
 LDA scradr
 STA (dlz),Y
 .IW dlz
 LDA scradr+1
 STA (dlz),Y
 .IW dlz
 LDA #$4F
 STA (dlz),Y
 .IW dlz
 LDA scradr
 STA (dlz),Y
 .IW dlz
 LDA scradr+1
 STA (dlz),Y
 .IW dlz
 LDA #$4F
 STA (dlz),Y
 .IW dlz
 LDA scradr
 STA (dlz),Y
 .IW dlz
 LDA scradr+1
 STA (dlz),Y
 .IW dlz
 LDA #$4F
 STA (dlz),Y
 .IW dlz
 LDA scradr
 STA (dlz),Y
 .IW dlz
 LDA scradr+1
 STA (dlz),Y
 .IW dlz
 .AIW 40,scradr
 DEX 
 BNE dl_cont
 JMP dl_end
 dl_cont:
 JMP dl_loop
 dl_end:
 LDA #$41
 STA (dlz),Y
 .IW dlz
 LDA #<dl
 STA (dlz),Y
 .IW dlz
 LDA #>dl
 STA (dlz),Y
 .IW dlz
 RTS 
 scradr:DFW scr
 initdl2:
  ; yep this is a copy of the upper
  ; rout was too lazy to do more
  ; a flexible rout
 .MIW dl2,dlz
  ; 3*8 blank lines
 LDA #$70
 LDY #0
 STA (dlz),Y
 .IW dlz
 STA (dlz),Y
 .IW dlz
 STA (dlz),Y
 .IW dlz
 LDX #$30
 dl_loop2:
 LDA #$4F
 STA (dlz),Y
 .IW dlz
 LDA scradr2
 STA (dlz),Y
 .IW dlz
 LDA scradr2+1
 STA (dlz),Y
 .IW dlz
 LDA #$4F
 STA (dlz),Y
 .IW dlz
 LDA scradr2
 STA (dlz),Y
 .IW dlz
 LDA scradr2+1
 STA (dlz),Y
 .IW dlz
 LDA #$4F
 STA (dlz),Y
 .IW dlz
 LDA scradr2
 STA (dlz),Y
 .IW dlz
 LDA scradr2+1
 STA (dlz),Y
 .IW dlz
 LDA #$4F
 STA (dlz),Y
 .IW dlz
 LDA scradr2
 STA (dlz),Y
 .IW dlz
 LDA scradr2+1
 STA (dlz),Y
 .IW dlz
 .AIW 40,scradr2
 DEX 
 BNE dl_cont2
 JMP dl_end2
 dl_cont2:
 JMP dl_loop2
 dl_end2:
 LDA #$41
 STA (dlz),Y
 .IW dlz
 LDA #<dl
 STA (dlz),Y
 .IW dlz
 LDA #>dl
 STA (dlz),Y
 .IW dlz
 RTS 
 scradr2:DFW scr+$800
  ; ----------------------------
 mul:
  ; multiplication rout
 LDA #0
 STA ext+1
 LDY #$11
 mulloop:
 LSR ext+1
 ROR  
 ROR acc+1
 ROR acc
 BCC mul2
 CLC 
 ADC aux
 PHA 
 LDA aux+1
 ADC ext+1
 STA ext+1
 PLA 
 mul2:
 DEY 
 BNE mulloop
 STA ext
 RTS 
 acc:DFW 0
 aux:DFW 0
 ext:DFW 0
  ; ----------------------------
  ; data
  ; ----------------------------
 olddl:DFW 0
 old623:DFB 0
 sintab:
 DFB $0,$6,$C,$12,$17,$1C,$20
 DFB $23,$26,$27,$28,$27,$26
 DFB $23,$20,$1C,$17
 DFB $12,$C,$6,$0
 DFB $FA,$F4,$EE,$E9
 DFB $E4,$E0,$DD,$DA
 DFB $D9,$D8,$D9,$DA,$DD,$E0
 DFB $E4,$E9,$EE,$F4,$FA
 sinend:
 DFB $0,$6,$C,$12,$17,$1C,$20
 DFB $23,$26,$27,$28,$27,$26
 DFB $23,$20,$1C,$17
 DFB $12,$C,$6,$0
 DFB $FA,$F4,$EE,$E9
 DFB $E4,$E0,$DD,$DA
 DFB $D9,$D8,$D9,$DA,$DD,$E0
 DFB $E4,$E9,$EE,$F4,$FA
  ; 
  ; 
 ORG $6000
 dl:
 ASC "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
 ASC "aaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
 ORG $6800
 dl2:
  ; screen
 ORG $3000
 scr:
 DFB $12,$34,$56,$78
 DFB $9A,$BC,$DE,$F0
 
