; 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"
 .macpack atari ; for scrcode macro
 .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
 maxparticles = $80 ; 2 bytes
 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

 linebuf = $0580
 textbuf = $0590
 fptmp = $05a0
 cloksav = $a0
 seedtype = $9f
 old_dma = $9c
 old_dl = $9d

 xex_org loadaddr
 .include "io.s" ; printchrx and getchrx

 ; init stuff gets done once, at startup
init:
 lda SDMCTL
 sta old_dma
 lda SDLSTL
 sta old_dl
 lda SDLSTH
 sta old_dl+1

 ; "New" option jumps here, restore GR.0 screen
getargs:
 lda #$90
 sta COLOR2
 lda #$0e
 sta COLOR1
 lda #$ff
 sta CH
 lda old_dl
 sta SDLSTL
 lda old_dl+1
 sta SDLSTH
 lda old_dma
 sta SDMCTL

 ; set default particles (if user just hits return)
 lda #<DEFAULTPART
 sta maxparticles
 lda #>DEFAULTPART
 sta maxparticles+1

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

 ; use CIO to read input, so user can use backspace/etc.
 jsr readline
 lda linebuf
 cmp #$9b
 beq usedefault ; if user hit Return
 ; use floating point ROM to convert input to an integer.
 lda #0
 sta CIX
 jsr AFP ; ASCII to floating point, result in FR0
 bcs printmsg ; C set means error
 jsr FPI ; convert FR0 to integer (result in FR0)
 bcs printmsg
 lda FR0
 tax
 ora FR0+1 ; we don't accept 0 for an answer!
 beq printmsg
 lda FR0+1
 stx maxparticles
 sta maxparticles+1

usedefault:

 ; print seed type prompt
 ldx #0
pm2loop:
 lda msg2,x
 beq pm2done
 jsr printchrx
 inx
 bne pm2loop
pm2done:

readgen:
 jsr getchrx
 cmp #$9b
 bne noteol
 lda #$31
noteol:
 cmp #$31
 bcc readgen
 cmp #$35
 bcs readgen
 and #$0f
 tax
 dex
 stx seedtype

generate: ;;; start of generate()
 jsr initscreen
 ; 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

 jsr drawseed

next_particle:
 ldy RANDOM ; spawn a new particle
 lda (spawn_x),y
 sta part_x
 lda (spawn_y),y
 sta part_y
 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 cloksav
 lda RTCLOK+1
 sta cloksav+1
 lda RTCLOK+2
 sta cloksav+2

; print menu
 ldx #menulen
menuloop:
 lda menumsg,x
 sta textbuf,x
 dex
 bpl menuloop

; calculate and print elapsed time in minutes.
; uses the floating point ROM routines, because it's easier to code
; this way and we don't need speed here.
 ldx #0
 stx FR0
 inx
 stx FR0+1
 jsr IFP   ; FR0 now FP 256.0
 jsr FMOVE ; FR1 = FR0 (both are 256.0)
 jsr FMUL  ; FR0 = FR0 * FR1 (65536.0)
 jsr FMOVE ; FR1 = FR0
 ldx #0
 stx FR0+1
 lda cloksav
 sta FR0
 jsr IFP       ; FR0 now cloksav in FP, FR1 = 65536.0
 jsr FMUL      ; FR0 = FR0 * FR1
 jsr FMOVE     ; FR1 = FR0, aka the high byte of cloksav in jiffies
 lda cloksav+1 ; convert low 2 bytes of cloksav to FP...
 sta FR0+1
 lda cloksav+2
 sta FR0
 jsr IFP  ; ...ok, now:
 jsr FADD ; add the high bytes in jiffies, result in FR0 again

 ; we now have the 3-byte jiffy count in FR0.
 ; 3600 NTSC jiffies or 3000 PAL jiffies = 1 minute, so divide.
 ; floating point constants:
 ; 3600.0 is $41,$36,$00,$00,$00,$00
 ; 3000.0 is $41,$30,$00,$00,$00,$00
 ldx #FR1
 jsr ZF1
 lda #$41 ; excess-64 base-100 exponent and sign (bit 7 = 0 means positive)
 sta FR1
 ldx #$36 ; 1st mantissa BCD byte, NTSC
 lda PAL
 and #$0e
 bne ntsc
 ldx #$30 ; 1st mantissa BCD byte, PAL
ntsc:
 stx FR1+1
 jsr FDIV  ; FR0 = FR0 / FR1
 jsr FASC  ; render as ASCII

 ; Now clean up the output from FASC and copy it to our menu line.
 ; FASC puts its results at LBUFF ($0580, aka linebuf).
 ; Unfortunately it can have a leading zero, and the last
 ; digit has the high bit set (as a terminator). We want only
 ; 6 characters including the decimal point, which could be e.g.
 ; 0.1234 (the 0 will show as a space) or 1.2345  12.345  123.45  1234.5
 ; Really elegant software would print this as minutes and seconds,
 ; with tenths of seconds, e.g. 1:23.4. Not that worried about it though.
 ldx #$ff
 lda linebuf
 cmp #'0' ; skip the leading zero if present (a space will be seen in its place)
 bne ascloop
 inx
ascloop:
 inx
 lda linebuf,x
 and #$df ; convert to screencode
 bmi ascdone ; hit the terminator digit
 sta textbuf,x
 cpx #6
 bne ascloop
 beq xdone

ascdone:
 and #$7f
 sta textbuf,x
 inx

xdone:
 lda #$6d ; screen code for "m"
 sta textbuf,x

 ; user might have hit some random key during plotting; ignore it.
keyloop:
 ldx #$ff
 stx CH

waitkey:
 lda CH
 cmp #$ff
 beq waitkey

 ; see what key was hit
 and #$3f ; ignore shift and inverse
 cmp #$28 ; Redo
 bne notredo
 jmp generate
notredo:
 cmp #$3e ; Save
 beq saveimage
 cmp #$23 ; New
 bne keyloop ; ignore any other keystroke
 jmp getargs
 ;;; End of generate()

;;; Subroutine: saveimage
;;; Does exactly what it says on the tin: saves the image.
;;; For now, the filename is hardcoded and there's no error checking.
;;; TODO: prompt for filename, report errors (with retry).
saveimage:
 ; CIO is nice, but it's kind of a PITA to use...
 ; OPEN #1,8,0,<filename>
 ldx #$10
 lda #3 ; OPEN
 sta ICCOM,x
 lda #<filename
 sta ICBAL,x
 lda #>filename
 sta ICBAH,x
 lda #fnlen
 sta ICBLL,x
 lda #0
 sta ICBLH,x
 sta ICAX2,x
 lda #8
 sta ICAX1,x
 jsr CIOV

 ; write data to file
 ldx #$10
 lda #$0b ; write binary record
 sta ICCOM,x
 lda #<screen
 sta ICBAL,x
 lda #>screen
 sta ICBAH,x
 lda #<screenbytes
 sta ICBLL,x
 lda #>screenbytes
 sta ICBLH,x
 jsr CIOV

 ; CLOSE #1
 ldx #$10
 lda #$0c ; close
 sta ICCOM,x
 jsr CIOV
 jmp keyloop

;;; 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:
 lda #<screen
 sta pixptr
 lda #>screen
 sta pixptr+1

 ; first, clear linebuf and textbuf
 lda #0
 tay
isloop0:
 sta linebuf,y
 iny
 cpy #$40
 bne isloop0

 ; next, clear screen memory
 ldx #>screenbytes ; clear this many pages
 tay ; 0 again
isloop:
 sta (pixptr),y
 iny
 bne isloop
 inc pixptr+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

 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.
;;; - returns with cursor_x in X reg, pixmask in A reg too.
;;; Called by plot, unplot, and drunkwalk (a lot!)
plotsetup:
 ldx cursor_y
 lda lineaddrs_l,x
 sta pixptr
 lda lineaddrs_h,x
 sta pixptr+1

 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
;;;; Inlined (keep for reference)
;locate:
; jsr plotsetup
; and (pixptr),y
; rts

;;; Subroutine: spawn
;;; Pick a random point on the edge of a circle
;;;; Inlined (keep for reference)
; 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 is the innermost loop, so it should be as optimized as
;;; possible (we're not there yet).
drunkwalk:
 ; using bit/bmi/bvc saves 6.25 cycles on average, compared to
 ; immediate cmp and bne.
 ; 4 code paths: up=14, down=15, left=15, right=13, avg=14.25
 bit RANDOM ;4 ; use top 2 bits (probably more random, definitely faster)
 bmi lr     ;2/3
 bvc down   ;2/3
 dec part_y ;3 ; N=1 V=1 up
 bne checkbounds ;3
down:
 inc part_y ;3 ; N=1 V=0 down
 bne checkbounds ;3
lr:
 bvc right ;2/3
 dec part_x ;3 ; N=0 V=1 left
 bne checkbounds ;3
right:
 inc part_x ;3

checkbounds:
 lda part_x
 cmp min_x
 beq oob
 cmp max_x
 beq oob
 sta cursor_x
 lda part_y
 cmp min_y
 beq oob
 cmp max_y
 beq oob
 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

 ; check neighbors. used to be a subroutine, inlined it.
 ; also inlined plotsetup here.
 ; (-1,0)
 dec cursor_x
 ldx cursor_y
 lda lineaddrs_l,x
 sta pixptr
 lda lineaddrs_h,x
 sta pixptr+1
 ldx cursor_x
 ldy xoffsets,x
 lda xmasks,x
 and (pixptr),y
 bne stick
 ; (1,0)
 inx
 stx cursor_x
 inx
 ldy xoffsets,x
 lda xmasks,x
 and (pixptr),y
 bne stick
 ; (0,-1)
 dec cursor_y
 ldx cursor_y
 lda lineaddrs_l,x
 sta pixptr
 lda lineaddrs_h,x
 sta pixptr+1
 ldx cursor_x
 ldy xoffsets,x
 lda xmasks,x
 sta pixmask
 and (pixptr),y
 bne stick
 ; (0,1)
 tya
 ora #$40 ; add 64
 tay
 lda (pixptr),y
 and pixmask
 bne stick
 jmp drunkwalk ; too far for a branch

stick:
oob:
 rts

;;; Subroutine: drawseed
;;; dispatch to appropriate seed subroutine
drawseed:
 ldx seedtype
 lda seeds_h,x
 pha
 lda seeds_l,x
 pha
 rts

;;; Subroutine: seed_point
;;; draw initial point in center
seed_point:
 lda #$7f
 sta cursor_x
 lda #$5f
 sta cursor_y
 jmp plot

;;; Subroutine: seed_long
;;; horizontal line, the width of the screen
seed_long:
 lda #$1
 sta cursor_x
 lda #$5f
 sta cursor_y
slnoop:
 jsr plot
 inc cursor_x
 lda cursor_x
 cmp #$ff
 bne slnoop
 rts

;;; Subroutine: seed_plus
;;; plus share, made of two 20px lines intersecting in the center
seed_plus:
 lda #$7f
 sta cursor_x
 lda #$55
 sta cursor_y
sploop:
 jsr plot
 inc cursor_y
 lda cursor_y
 cmp #$69
 bne sploop
 lda #$75
 sta cursor_x
 lda #$5f
 sta cursor_y
slloop:
 jsr plot
 inc cursor_x
 lda cursor_x
 cmp #$89
 bne slloop
 rts

;;; Subroutine: seed_4pt
;;; four points, the corners of a 20px square
seed_4pt:
 lda #$75
 sta cursor_x
 lda #$55
 sta cursor_y
 jsr plot
 lda #$68
 sta cursor_y
 jsr plot
 lda #$88
 sta cursor_x
 jsr plot
 lda #$55
 sta cursor_y
 jmp plot

;;; Subroutine: readline
;;; Read a line from E:, store result in linebuf.
;;; The terminating EOL ($9b) gets stored at the end.
;;; linebuf happens to be right where the FP ROM needs it for AFP.
readline:
 lda #<linebuf
 sta INBUFF
 sta ICBAL
 lda #>linebuf
 sta INBUFF+1
 sta ICBAH
 lda #0
 sta ICBLH
 lda #10
 sta ICBLL
 lda #5
 sta ICCOM
 ldx #0
 jmp CIOV

;;;;; end of executable code, data tables from here on out.

; prompts
msg:
 .byte $7d, "Diffusion Limited Aggregate",$9b
 .byte "Urchlay's ASM version 0.0.7",$9b,$9b
 .byte "Particle count range: 1 to 65535",$9b
 .byte "How many particles [",.sprintf("%d", DEFAULTPART),"]? ",$0
msg2:
 .byte $9b,"Seed Type: ",$9b,"1=Dot 2=Plus 3=4Dots 4=Line [1]? ",$0

; screen codes for menu
menumsg:
 .byte $00,$00,$00     ; 3 digits of minutes
 .byte $00             ; 1 decimal point
 .byte $00,$00         ; 2 digits fractional minutes
 .byte $00             ; 1 the letter "m"
 .byte $00,$00         ; 2 spaces
 .byte 'S'-$20+$80     ; 1
 scrcode "ave "        ; 3
 .byte 'R'-$20+$80     ; 1
 scrcode "edo "        ; 4
 .byte 'N'-$20+$80     ; 1
 scrcode "ew?"         ; 4
 .byte $80             ; 1 (cursor)
 .byte $00,$00,$00,$00 ; 4 (filler)
menulen = * - menumsg - 1

 ; filename for Save command
filename: .byte "D:DLA.IMG"
fnlen = *-filename+1

 ; jump table for seed functions
seeds_l: .byte <(seed_point-1),<(seed_plus-1),<(seed_4pt-1),<(seed_long-1)
seeds_h: .byte >(seed_point-1),>(seed_plus-1),>(seed_4pt-1),>(seed_long-1)

 ; 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 384 bytes, but compared to calculating the address, is
 ; twice as fast!
lineaddrs_l:
 laddr .set screen
 .repeat 192
  .byte <laddr
  laddr .set laddr + $20
 .endrep

lineaddrs_h:
 laddr .set screen
 .repeat 192
  .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
 gr0    = $02
 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 - 132
  .byte gr8
 .endrep
 .byte gr0 | lms
 .word textbuf
 .byte jvb
 .word dlist

 xex_run init