; 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 "dlaver.inc"
 .include "atari.inc"
 .include "xex.inc"
 .include "nextpage.inc"

 ; This used to be $2000, which worked fine with DOS 2.0S and
 ; Sparta 3.2d. But there's no reason to make it that low, and
 ; making it higher lets it work with more memory-hungry DOSes.
 loadaddr = $2a00

 lowcode = $0600 ; memcheck and io.s
 screen = $4000 ; must be on a x000 (4K) boundary
 screen2 = screen + $1000 ; rest of screen RAM after 4K boundary
 savebuf = screen + $6000 ; prepare_output
 pixarray = screen + $20
 linelen = $20 ; aka 32 bytes, antic F (GR.8) in narrow mode.
 maxlines = $aa ; 170 lines of display
 screenbytes = maxlines * linelen
 dl_len = 202 ; remember to update this if you modify the display list!
 dlist = screen - dl_len
 DMA_ON = $21
 DEFAULTPART = 1000
 linebuf = $0580
 textbuf = $0590

 .bss
 .org $80

maxparticles: .res 2 ; user's response to "How many particles?"
seedtype:     .res 1 ; user's response to seed type prompt (minus one; 0-3)

pixptr:       .res 2 ; used by plot and drunkwalk
pixmask:      .res 1 ; used by render
cursor_x:     .res 1 ; cursor x/y are args to plot and drunkwalk
cursor_y:     .res 1
pixptr2:      .res 2 ; used by drunkwalk
screenptr = pixptr2  ; used by render

circlesize:   .res 1 ; 0 to 3

particles:    .res 2
spawn_x:      .res 2
spawn_y:      .res 2

old_dma:      .res 1 ; these 3 are for restoring GR.0 mode
old_dl:       .res 2
old_savmsc:   .res 2
old_color0:   .res 1
old_color1:   .res 1
old_color2:   .res 1

cloksav:      .res 3 ; hold RTCLOK here while we convert to MM:SS.CC
fptmp:        .res 6 ; used in mmss.s
po_line = fptmp      ; used by prepare_output

 .code

 ;;; init xex segment: check that there's enough memory.
 xex_org lowcode
 rts ; this is here for DOS XL
 .include "io.s" ; printchrx and getchrx
 .include "printint.s"

 ; If memcheck doesn't see >=48K of RAM, abort loading.
 ; The only 2 ways I know of for an init segment of a xex file
 ; to abort loading to rest of the file are jmp (DOSVEC) and jmp
 ; WARMST. An rts just continues the load. Closing IOCB #1, then doing
 ; an rts, causes the Atari to lock up. Of the two, jumping though
 ; DOSVEC seems more polite to the user: It returns to the DOS menu.
 ; With a non-DOS setup ("atari800 dla.xex" or "atariserver dla.xex"),
 ; it ends up at the self-test menu (from which, Reset will get him
 ; back to BASIC, if it's enabled).
memcheck:
 lda RAMTOP
 cmp #$c0 ; 48K
 bcs mem_ok
 lda #<memmsg
 ldx #>memmsg
 jsr printmsg
 lda RAMTOP ; free RAM in pages, divide by 4 to get K
 lsr
 lsr
 jsr printdecb
 lda #<memmsg2
 ldx #>memmsg2
 jsr printmsg
 jsr getchr ; wait for user to press a key
 jmp (DOSVEC) ; get outta here (back to DOS)
mem_ok:
 rts

memmsg:  .byte "Need 48K, only have ",0
memmsg2: .byte "K.",$9b,"Disable BASIC, remove cartridge?",$9b
         .byte "Press any key...",0

 xex_init memcheck

 ;;; main xex segment: the actual program. the functions in io.s
 ;;; and printint.s are still in low memory.
 xex_org loadaddr
 rts ; this is here for DOS XL
 .include "mmss.s"

 ; init stuff gets done once, at startup
init:
 lda #0
 sta seedtype ; default seed type is the single pixel
 sta LMARGN
 lda SDMCTL
 sta old_dma

 lda SDLSTL
 sta old_dl
 lda SDLSTH
 sta old_dl+1
 lda SAVMSC
 sta old_savmsc
 lda SAVMSC+1
 sta old_savmsc+1

 lda COLOR0
 sta old_color0
 lda COLOR1
 sta old_color1
 lda COLOR2
 sta old_color2

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

 ; "New" option jumps here, restore GR.0 screen
getargs:
 jsr restore_gr0

printbanner:
 lda #<banner
 ldx #>banner
 jsr printmsg

 ; prompt for # of particles.
prompt4part:
 lda #<partprompt
 ldx #>partprompt
 jsr printmsg

 lda maxparticles
 ldx maxparticles+1
 jsr printdecw

 lda #<partprompt2
 ldx #>partprompt2
 jsr printmsg

 ; use CIO to read input, so user can use backspace/etc.
 jsr readline

 ; check for error (user hit Break or Ctrl-3 for EOF).
 cpy #1
 bne prompt4part

 lda linebuf ; look at first character entered

 ; if user hit Return by itself, use the old value.
 cmp #$9b
 beq prompt4seed

 ora #$20 ; ignore case...
 cmp #'q' ; Q means Quit.
 bne convinput

 jsr confirm_quit ; this doesn't return, if the user quits.

convinput:
 ; use floating point ROM to convert input to an integer.
 lda #0
 sta CIX
 jsr AFP ; ASCII to floating point, result in FR0
 bcs prompt4part ; C set means error (negative or >65535)
 jsr FPI ; convert FR0 to integer (result in FR0)
 bcs prompt4part
 lda FR0
 tax
 ora FR0+1 ; we don't accept 0 for an answer!
 beq prompt4part
 lda FR0+1
 stx maxparticles
 sta maxparticles+1

prompt4seed:
 ; print seed type prompt
 lda #<seedprompt
 ldx #>seedprompt
 jsr printmsg
 ldx seedtype
 inx
 txa
 jsr printdecb
 lda #<seedprompt2
 ldx #>seedprompt2
 jsr printmsg

readseed:
 jsr getchr ; N.B. getchrx won't work here (see io.s)
 cpy #1
 bne readseed

 cmp #$9b
 beq dfltseed ; use default if user pressed return
 cmp #$31
 bcc readseed
 cmp #$35
 bcs readseed
 and #$0f
 tax
 dex
 stx seedtype
dfltseed:
 lda #$9b
 jsr printchr

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 DMACTL
 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:
 jsr drunkwalk     ; spawn, walk around, plot (all in one)
 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:
 jsr render
 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 elapsed time. see mmss.s for gory details.
 jsr print_mmss

 ; print menu, wait for keystroke.
 lda #<menumsg
 ldx #>menumsg
 jsr printmsg

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

waitkey:
 jsr getchr

 ; see what key was hit. don't need extra code for Break or ^3 here.
 and #$5f    ; ignore case
 cmp #'R'    ; Redo
 bne notredo
 jmp generate
notredo:
 cmp #'S'    ; Save
 beq saveimage
 cmp #'N'    ; New
 bne waitkey ; ignore any other keystroke
 jmp getargs
 ;;; End of generate()

;;; Subroutine: saveimage
;;; Does exactly what it says on the tin: saves the image.
;;; User is prompted for a filename. In case of disk error,
;;; there's a "Retry [Y/n]?" prompt.
saveimage:
 jsr restore_gr0  ; back to GR.0, so we can...
 lda #<saveprompt
 ldx #>saveprompt
siprompt:
 jsr printmsg     ; ...prompt for, and...
 jsr readline     ; ...let the user type a filename.

 ; if user hit Break or ^3, prompt again.
 cpy #1
 bne siprompt

 jsr close1       ; make sure the IOCB is closed before we open it!

 ; prepend D: to the filename, if there's no device given.
 lda linebuf+1
 cmp #':'
 beq prepare_output
 lda linebuf+2
 cmp #':'
 beq prepare_output

 ldy ICBLL
dloop:
 lda linebuf,y
 sta linebuf+2,y ; make for for D:
 dey
 bpl dloop

 ; insert D: and add 2 to the buffer length.
 lda #'D'
 sta linebuf
 lda #':'
 sta linebuf+1
 inc ICBLL
 inc ICBLL

 ; DLA pixel size is 170x170, screen memory is 256x170. only save
 ; the middle 22 bytes (176 pixels) of each line. Really only need
 ; 170 pixels, but of course we can't save a partial byte...
prepare_output:
 lda #<screen
 sta screenptr
 lda #>screen
 sta screenptr+1
 lda #<savebuf
 sta pixptr
 lda #>savebuf
 sta pixptr+1
 lda #0
 sta po_line
polineloop:
 ldy #5
 ldx #0
poloop:
 lda (screenptr),y
 sta (pixptr,x)
 inc pixptr
 bne ppok
 inc pixptr+1
ppok:
 iny
 cpy #$1b
 bne poloop
 lda screenptr
 clc
 adc #$20
 sta screenptr
 lda screenptr+1
 adc #0
 sta screenptr+1
 inc po_line
 ldx po_line
 cpx #maxlines
 bne polineloop

open_output:
 ; 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 #<linebuf
 sta ICBAL,x
 lda #>linebuf
 sta ICBAH,x
 ldy ICBLL ; length returned by CIO when we called readline...
 dey       ; ...but one byte too long (due to the EOL).
 tya
 sta ICBLL,x
 lda #0
 sta ICBLH,x
 sta ICAX2,x
 lda #8
 sta ICAX1,x
 jsr CIOV
 cpy #1   ; CIO returns with Y=1 for success.
 bne save_error

 ; write data to the channel
 ldx #$10
 lda #$0b ; write binary record
 sta ICCOM,x
 lda #<savebuf
 sta ICBAL,x
 lda #>savebuf
 sta ICBAH,x
 lda #<(maxlines*22)
 sta ICBLL,x
 lda #>(maxlines*22)
 sta ICBLH,x
 jsr CIOV
 cpy #1
 bne save_error

 ; close the channel
 jsr close1
 cpy #1
 bne save_error

 ; let the user know the save worked.
 lda #<saveokmsg
 ldx #>saveokmsg
 jsr printmsg
 jsr getchr ; any key
 jmp getargs

 ; print error message, prompt for retry.
save_error:
 tya
 pha
 lda #<diskerrmsg
 ldx #>diskerrmsg
 jsr printmsg
 pla
 jsr printdecb
 lda #<retrymsg
 ldx #>retrymsg
 jsr printmsg
get_retry_key:
 jsr getchr
 cmp #$9b ; return = yes
 beq jsaveimage
 and #$5f ; ignore case
 cmp #'Y'
 beq jsaveimage
 cmp #'N'
 bne get_retry_key
 jmp getargs
jsaveimage:
 lda #$9b
 jsr printchr
 jmp saveimage

;;; Subroutine: set_limits
;;; Sets the X/Y min/max limits based on circlesize.
;;; Preserves Y register, trashes everything else.
; The selfmod_* addresses are operands to compare instructions,
; found in drunkwalk.s.
set_limits:
 ldx circlesize
 lda xmin,x
 sta selfmod_xmin
 lda ymin,x
 sta selfmod_ymin
 lda xmax,x
 sta selfmod_xmax
 lda ymax,x
 sta selfmod_ymax
 rts

;;; Subroutine: initscreen
;;; Clear screen and pixarray memory, point ANTIC to our display list.
;;; no arguments. trashes all registers.
; Take 18 jiffies (0.3 sec). Probably not worth optimizing.
; Uncomment next line to see how long it takes (check locations
; $0600-$0603 in atari800 debugger).
; INITSCR_PROFILE = 1
initscreen:
.ifdef INITSCR_PROFILE
 lda RTCLOK+1
 sta $0600
 lda RTCLOK+2
 sta $0601
.endif

 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 #$72 ; 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

 ; sneaky: tell the E: driver that screen RAM starts in our buffer,
 ; so we can use printchr and printchrx to print to the bottom text
 ; line in graphics mode.
 lda #<textbuf
 sta SAVMSC
 lda #>textbuf
 sta SAVMSC+1
 lda #0
 sta ROWCRS
 sta COLCRS
 sta COLCRS+1
.ifdef INITSCR_PROFILE
 lda RTCLOK+1
 sta $0602
 lda RTCLOK+2
 sta $0603
.endif
 rts

 .include "render.s"

;;; Subroutine: plot
;;; Turns on the pixel at (cursor_x, cursor_y), in pixarray.
;;; Trashes all registers (and pixptr).
plot:
 ldx cursor_y
 lda lineaddrs_l,x
 sta pixptr
 lda lineaddrs_h,x
 sta pixptr+1
 ldy cursor_x
 lda #1
 sta (pixptr),y
 rts

 ; drunkwalk is less than a page long. nextpage macro starts it
 ; on a page boundary, so branches don't cost an extra cycle.
 nextpage
 .include "drunkwalk.s"

;;; 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 #center_x
 sta cursor_x
 lda #center_y
 sta cursor_y
 jmp plot

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

;;; Subroutine: seed_plus
;;; plus share, made of two 20px lines intersecting in the center
seed_plus:
 lda #center_x
 sta cursor_x
 lda #center_y-10
 sta cursor_y
sploop:
 jsr plot
 inc cursor_y
 lda cursor_y
 cmp #center_y+10
 bne sploop
 lda #center_x-10
 sta cursor_x
 lda #center_y
 sta cursor_y
slloop:
 jsr plot
 inc cursor_x
 lda cursor_x
 cmp #center_x+10
 bne slloop
 rts

;;; Subroutine: seed_4pt
;;; four points, the corners of a 20px square
seed_4pt:
 lda #center_x-10
 sta cursor_x
 lda #center_y-10
 sta cursor_y
 jsr plot
 lda #center_y+10
 sta cursor_y
 jsr plot
 lda #center_x+10
 sta cursor_x
 jsr plot
 lda #center_y-10
 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 #32 ; buffer length; longer than we need
 sta ICBLL
 lda #5
 sta ICCOM
 ldx #0
 jmp CIOV

;;; Subroutine: restore_gr0
;;; Restore the OS's GRAPHICS 0 display, so we can use E:
restore_gr0:
 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
 lda old_savmsc
 sta SAVMSC
 lda old_savmsc+1
 sta SAVMSC+1
 rts

;;; Subroutine: close1
;;; Closes IOCB 1, same as CLOSE #1 in BASIC.
close1:
 ldx #$10
 lda #$0c ; close
 sta ICCOM,x
 jmp CIOV

;;; Subroutine: confirm_quit
confirm_quit:
 lda #<exit_prog_msg
 ldx #>exit_prog_msg
 jsr printmsg
 jsr getchr
 ora #$20 ; ignore case, Y or y
 cmp #'y'
 beq quit
 rts      ; user changed his mind

quit:
 ; user wants to quit.
 ; before we bail out, restore the console colors. this won't
 ; matter for DOS 2 style DOSes, but it will for Sparta.
 lda old_color0
 sta COLOR0
 lda old_color1
 sta COLOR1
 lda old_color2
 sta COLOR2
 ; exit, stage left.
 jmp (DOSVEC)

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

; prompts.
; banner and saveprompt must start with a clear-screen code.
banner:
 .byte $7d, "Diffusion Limited Aggregate",$9b
 .byte "Urchlay's ASM version ",VERSION,$9b,$0

partprompt:
 .byte $9b,"Particle count range: 1 to 65535",$9b
 .byte "How many particles [",$0

partprompt2:
 .byte "], Q=Quit? ",$0

seedprompt:
 .byte $9b,"Seed Type: ",$9b,"1=Dot 2=Plus 3=4Dots 4=Line [",$0

seedprompt2:
 .byte "]? ",$0

saveprompt:
 .byte $7d, "Save: Enter filename:",$9b,"> ",$0

saveokmsg:
 .byte "Saved OK, press any key...",$0

diskerrmsg:
 .byte "I/O Error ",$0

retrymsg:
 .byte "  Retry [Y/n]? ",$0

; this prompt has to be <22 bytes long, and can NOT contain any
; screen control codes, because when it's printed we're only
; printing to a 32-byte buffer (which we told the OS was the
; start of a GR.0 screen, but that was designated "a lie").
menumsg:
 .byte "   "
 .byte ' ','S'|$80,"ave"
 .byte ' ','R'|$80,"edo"
 .byte ' ','N'|$80,"ew? "
 .byte 0

exit_prog_msg:
 .byte "Exit program[y/N]? ", 0

 ; 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.
 ; these 2 tables (low and high bytes) are less than a page each.
 ; nextpage macro guarantees they don't cross a page boundary (so
 ; indexed addressing doesn't cost an extra cycle).
 nextpage
lineaddrs_l:
 laddr .set pixarray
 .repeat 170
  .byte <laddr
  laddr .set laddr + 170
 .endrep

 nextpage
lineaddrs_h:
 laddr .set pixarray
 .repeat 170
  .byte >laddr
  laddr .set laddr + 170
 .endrep

 .if dlist < *
  .error .sprintf("main program too long, %d byte overlap with dlist", * - dlist)
 .endif

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

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

 xex_run init