path: root/dla.s

; Diffusion Limited Aggregation
; B. Watson's asm rewrite of ChrisTOS's Atari 8-bit version.
; Original lives here: https://github.com/ctzio/DLA/

; This version uses ANTIC narrow playfield mode, since the original
; uses fewer than 256 columns of a GR.8 screen. This gives a slight
; speed boost for 2 reasons: less DMA from the ANTIC chip, and we get
; to use 1 byte for the X coordinate.

 .include "atari.inc"
 .include "xex.inc"

 loadaddr = $2000
 screen = $4000 ; must be on a x000 (4K) boundary
 screen2 = screen + $1000 ; rest of screen RAM after 4K boundary
 linelen = $20 ; aka 32 bytes, antic F (GR.8) in narrow mode.
 maxlines = $C0 ; 192 lines of display
 screenbytes = maxlines * linelen
 dl_len = 202 ; remember to update this if you modify the display list!

 DMA_ON = $21
 DEFAULTPART = 1000
 screenptr = SAVMSC
 maxparticles = $80 ; 2 bytes
 addtmp = $82
 pixptr = $82
 pixmask = $84
 cursor_x = $85 ; cursor x/y are args to plot/unplot/locate
 cursor_y = $86
 min_x = $87 ; limits: if the particle gets outside this box,
 max_x = $88 ; delete it and spawn a new one.
 min_y = $89
 max_y = $8a
 circlesize = $8b ; 0 to 3
 part_x = $8c ; x/y coords of current particle
 part_y = $8d
 particles = $8e ; 2 bytes
 spawn_x = $90 ; 2 bytes
 spawn_y = $92 ; 2 bytes

 dlist = screen - dl_len

 ; start of init segment. gets overwritten by the main program...
 ; and since the rest of the xex isn't loaded yet, can't call
 ; subroutines from it!
 xex_org loadaddr
 .include "io.s" ; printchrx and getchrx
msg:
 .byte "Diffusion Limited Aggregate",$9b
 .byte "Urchlay's ASM version 0.0.3",$9b,$9b
 .byte "How many particles [",.sprintf("%d", DEFAULTPART),"]? ",$0
init:
 ; set default particles (if user just hits return)
 lda #<DEFAULTPART
 sta maxparticles
 lda #>DEFAULTPART
 sta maxparticles+1

 ; print banner and prompt.
 ldx #0
pmloop:
 lda msg,x
 beq pmdone
 jsr printchrx
 inx
 bne pmloop
pmdone:

 ; read up to 5 digits. for now, no editing.
 ldx #0
readloop:
 jsr getchrx
 cmp #$9b ; is it Return?
 beq readdone ; if so, done reading.
 cmp #$30 ; is it a digit?
 bcc readloop ; if not, ignore it.
 cmp #$3a
 bcs readloop
 sta LBUFF,x
 jsr printchrx
 inx
 cpx #5
 bne readloop
 lda #0
 sta LBUFF,x ; zero-terminate
readdone:
 cpx #0
 beq usedefault

 ; add up input digits
 lda #0
 sta maxparticles
 sta maxparticles+1
 ldx #0
digloop:
 lda LBUFF,x
 beq digitsdone ; hit zero terminator
 ldy #$0a
 lda #0
 sta addtmp
 sta addtmp+1
mul10loop:
 clc
 lda addtmp
 adc maxparticles
 sta addtmp
 lda addtmp+1
 adc maxparticles+1
 sta addtmp+1
 dey
 bne mul10loop
 lda LBUFF,x
 and #$0f
 clc
 adc addtmp
 sta maxparticles
 lda addtmp+1
 adc #0
 sta maxparticles+1
 inx
 bne digloop
 
digitsdone:
usedefault:
 rts

 xex_init init
;;;;; end of init segment

 xex_org loadaddr
main: ;;; start of main()
 jsr initscreen
 ; this stuff isn't working, commented out for now:
 ; wait for shadow regs to get updated...
 ;lda RTCLOK+2
;wl:
 ;cmp RTCLOK+2
 ;beq wl
 ;lda #1 ; ...turn off shadow reg updates (tiny speed boost)
 ;sta CRITIC
 lda #0
 sta particles
 sta particles+1
 sta RTCLOK
 sta RTCLOK+1
 sta RTCLOK+2
 sta circlesize
 jsr set_limits

 lda #<points_x
 sta spawn_x
 lda #>points_x
 sta spawn_x+1
 lda #<points_y
 sta spawn_y
 lda #>points_y
 sta spawn_y+1

 ; initial point in center
 lda #$7f
 sta cursor_x
 lda #$5f
 sta cursor_y
 jsr plot

 ; spawn a new particle
next_particle:
 jsr spawn
 ;lda #0
 ;sta CONSOL ; click when spawning a particle

 jsr drunkwalk     ; walk it around
 beq next_particle ; if it went out of bounds, try again

 ; particle stuck to an existing pixel, draw it
 lda part_x
 sta cursor_x
 lda part_y
 sta cursor_y
 jsr plot

 inc particles
 bne ph_ok
 inc particles+1
ph_ok:

 ; increase circlesize at appropriate particle counts
 ; if(particles == 100 || particles == 300 || particles == 600) goto next_size;
 lda particles
 ldx particles+1
 bne not_100
 cmp #100
 beq next_size
not_100:
 cpx #>300
 bne not_300
 cmp #<300
 beq next_size
not_300:
 cpx #>600
 bne checkmaxparts
 cmp #<600
 beq next_size
 bne checkmaxparts

next_size:
 inc circlesize
 jsr set_limits
 inc spawn_x+1
 inc spawn_y+1

checkmaxparts:
 ; if(particles != maxparticles) goto next_particle;
 lda particles
 cmp maxparticles
 bne next_particle
 lda particles+1
 cmp maxparticles+1
 bne next_particle

main_done:
 lda #0
 sta CRITIC
 sta COLOR2
 sta ATRACT
 lda #DMA_ON
 sta SDMCTL
 lda RTCLOK
 sta FR0
 lda RTCLOK+1
 sta FR0+1
 lda RTCLOK+2
 sta FR0+2
hang: jmp hang
; TODO: code to save image goes here.
;;; End of main()

;;; Subroutine: set_limits
;;; Sets the X/Y min/max limits based on circlesize
set_limits:
 ldx circlesize
 lda xmin,x
 sta min_x
 lda ymin,x
 sta min_y
 lda xmax,x
 sta max_x
 lda ymax,x
 sta max_y
 rts

;;; Subroutine: initscreen
;;; clear screen memory and point ANTIC to our display list.
;;; no arguments. trashes all registers.
initscreen:
 jsr set_screenptr

 ldx #>screenbytes ; clear this many pages
 lda #0
 tay
isloop:
 sta (screenptr),y
 iny
 bne isloop
 inc screenptr+1
 dex
 bne isloop

 lda #DMA_ON   ; set ANTIC narrow playfield mode
 sta SDMCTL

 lda #<dlist ; use our display list
 sta SDLSTL
 lda #>dlist
 sta SDLSTH
; fall through to next subroutine

;;; Subroutine: set_screenptr
;;; Set screenptr to the start of screen memory.
;;; Trashes A, preserves X and Y.
set_screenptr:
 lda #<screen
 sta screenptr
 lda #>screen
 sta screenptr+1
 rts

;;; Subroutine: plotsetup
;;; - set pixptr to point to screen memory at cursor_y.
;;; - set pixmask to the mask for cursor_x.
;;; - set Y reg to the byte offset for cursor_x.
;;; Called by plot, unplot, and locate.
plotsetup:
 ; used to:
 ;lda cursor_y
 ;sta pixptr
 ;lda #0
 ;sta pixptr+1
 ;ldx #5 ; multiply 16-bit pixptr by 32, by left-shifting 5 times.
;pshiftloop:
 ;asl pixptr
 ;rol pixptr+1
 ;dex
 ;bne pshiftloop
 ;clc ; add screenptr to calculated value
 ;lda pixptr
 ;adc screenptr
 ;sta pixptr
 ;lda pixptr+1
 ;adc screenptr+1
 ;sta pixptr+1

 ; now, use a table, which makes this run ~3.5x as fast!
 ldx cursor_y
 lda lineaddrs_l,x
 sta pixptr
 lda lineaddrs_h,x
 sta pixptr+1

 ; used to:
 ;lda cursor_x
 ;and #$07 ; keep low 3 bits...
 ;tax
 ;lda masks,x ; get the mask
 ;sta pixmask ; ...and save it
 ;lda cursor_x ; top 5 bits are byte offset, shift 'em down
 ;lsr
 ;lsr
 ;lsr
 ;tay ; put byte offset in Y

 ; now, use tables, which shaves another ~8% off runtime:
 ldx cursor_x
 ldy xoffsets,x
 lda xmasks,x
 sta pixmask

 rts

;;; Subroutine: plot
;;; plots a pixel at (cursor_x, cursor_y)
plot:
 jsr plotsetup
 lda (pixptr),y
 ora pixmask
 sta (pixptr),y
 rts

;;; Subroutine: unplot
;;; erases a pixel at (cursor_x, cursor_y)
unplot:
 jsr plotsetup
 lda pixmask
 eor #$ff
 sta pixmask
 lda (pixptr),y
 and pixmask
 sta (pixptr),y
 rts

;;; Subroutine: locate
;;; check the pixel at (cursor_x, cursor_y)
;;; if set, return with Z=0
;;; otherwise, return with Z=1
locate:
 jsr plotsetup
 lda (pixptr),y
 and pixmask
 rts

masks: .byte $80,$40,$20,$10,$08,$04,$02,$01

;;; Subroutine: spawn
;;; Pick a random point on the edge of a circle
spawn:
 ldy RANDOM
 lda (spawn_x),y
 sta part_x
 lda (spawn_y),y
 sta part_y
 rts

;;; Subroutine: drunkwalk
;;; Walk the point around randomly until it either is
;;; adjacent to a set pixel or goes out of bounds.
;;; Return with Z=0 if out of bounds, Z=1 if it hit a pixel.
;;; This and check_neighbors are the innermost loop, so they
;;; should be as optimized as possible (we're not there yet).
drunkwalk:
 lda RANDOM ; pick a random direction, up/down/left/right
 and #$C0   ; use top 2 bits (hopefully more random than bottom 2).
 cmp #$C0
 beq up
 cmp #$80
 beq down
 cmp #$40
 beq left
 ; right
 inc part_x
 bne checkbounds
up:
 dec part_y
 bne checkbounds
down:
 inc part_y
 bne checkbounds
left:
 dec part_x

checkbounds:
 lda part_x
 cmp min_x
 beq oob
 cmp max_x
 beq oob
 lda part_y
 cmp min_y
 beq oob
 cmp max_y
 beq oob

 lda part_x
 sta cursor_x
 lda part_y
 sta cursor_y
 ldx #0
 lda CONSOL
 cmp #6
 bne dontplot
 jsr plot
 jsr unplot
 ldx #DMA_ON
dontplot:
 stx SDMCTL ; nope, shadow updates are off...
 ;stx DMACTL
 jsr check_neighbors
 bne stick
 beq drunkwalk

stick:
oob:
 rts

;;; Subroutine: check_neighbors
;;; return with Z=1 if any of the 4 neighbor pixels (l/r/u/d)
;;; are set. otherwise, return Z=0.
check_neighbors:
 ; (-1,0)
 dec cursor_x
 jsr locate
 bne stick
 ; (1,0)
 inc cursor_x
 inc cursor_x
 jsr locate
 bne stick
 ; (0,-1)
 dec cursor_x
 dec cursor_y
 jsr locate
 bne stick
 ; (0,1)
 ; used to:
 ;inc cursor_y
 ;inc cursor_y
 ;jsr locate
 ; this avoids recalculating the pointer:
 tya
 ora #$40 ; add 64
 tay
 lda (pixptr),y
 and pixmask
 rts

;;;;; end of executable code

 ; dlatbl.s is generated by perl script, mkdlatbl.pl
 .include "dlatbl.s"

 ; table of addresses, for each line on the screen. bloats the
 ; code by 320 bytes, but compared to calculating the address, is
 ; 3.5x as fast!
lineaddrs_l:
 laddr .set screen
 .repeat 160
  .byte <laddr
  laddr .set laddr + $20
 .endrep

lineaddrs_h:
 laddr .set screen
 .repeat 160
  .byte >laddr
  laddr .set laddr + $20
 .endrep

 ; tables to replace X coord => mask-and-offset calculations.
xoffsets:
 xoffs .set 0
 .repeat 32
  .repeat 8
   .byte xoffs
  .endrep
  xoffs .set xoffs + 1
 .endrep

xmasks:
 .repeat 32
  .byte $80,$40,$20,$10,$08,$04,$02,$01
 .endrep

;;; display list
 ; ANTIC opcodes
 blank8 = $70
 gr8    = $0f
 lms    = $40
 jvb    = $41

 xex_org dlist
 .byte blank8, blank8, blank8
 .byte gr8 | lms
 .word screen
 .repeat 127
  .byte gr8
 .endrep
 .byte gr8 | lms
 .word screen2
 .repeat maxlines - 129
  .byte gr8
 .endrep
 .byte jvb
 .word dlist

 xex_run loadaddr