Croissant Runtime
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
crsn/examples/mandelbrot/mandelbrot-interactive.csn

305 lines
7.6 KiB

(
(def W 1024)
(def H 768)
(def DEF_MAXITER 50)
; ---
(sc-init W H)
(sc-opt SCREEN_AUTOBLIT 0)
(sym maxiter g0)
(ld maxiter DEF_MAXITER)
(lds @cout "Interactive Mandelbrot\n")
(lds @cout "----------------------\n")
(lds @cout "Navigate using WASD, zoom: Q+/E-, detail: R+/F-; fast move/zoom: LShift, force redraw: G\n")
(lds @cout "To get a high-res image, stop interacting for while\n")
(sym mb_x r7)
(sym mb_y r8)
(sym mb_s r9)
(sym mb_row r10)
; index into the skip/size table
(sym mb_skip_index r11)
; Interactive movement speed
(def ZOOM_STEP 0.1)
(def PAN_STEP 0.3)
; size of big pixels
(def COL_SKIP 8)
(def ROW_SKIP 8)
; incrementally renders 1x1, 2x2, 4x4, ...
(def MB_SKIP_TABLE_SIZE 80)
(def MB_SKIP_REPEAT_INDEX 16)
(sym mb_skip_table_x r12)
(sym mb_skip_table_y r13)
(sym mb_size_table r14)
(mkbf mb_skip_table_x (
0 4 0 4 2 6 0 2 4 6 2 6 0 2 4 6
; 8x8 grid
1 3 5 7 1 3 5 7 1 3 5 7 1 3 5 7
0 2 4 6 0 2 4 6 0 2 4 6 0 2 4 6
1 3 5 7 1 3 5 7 1 3 5 7 1 3 5 7
; do top left pixels again
0 2 4 6 0 2 4 6 0 2 4 6 0 2 4 6
))
(mkbf mb_skip_table_y (
0 0 4 4 0 0 2 2 2 2 4 4 6 6 6 6
; 8x8 grid
0 0 0 0 2 2 2 2 4 4 4 4 6 6 6 6
1 1 1 1 3 3 3 3 5 5 5 5 7 7 7 7
1 1 1 1 3 3 3 3 5 5 5 5 7 7 7 7
; do top left pixels again
0 0 0 0 2 2 2 2 4 4 4 4 6 6 6 6
))
(mkbf mb_size_table (
8 4 4 4 2 2 2 2 2 2 2 2 2 2 2 2
; 8x8 grid
1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
; do top left pixels again
1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
))
(ld mb_x 0.0)
(ld mb_y 0.0)
(ld mb_s 1.0)
(sym did_change r15)
(sym is_first_render r6)
(ld is_first_render 1)
(sym GRADIENT g1)
(mkbf GRADIENT (
0x421e0f 0x19071a 0x09012f 0x040449 0x000764 0x0c2c8a 0x1852b1 0x397dd1
0x86b5e5 0xd3ecf8 0xf1e9bf 0xf8c95f 0xffaa00 0xcc8000 0x995700 0x6a3403))
; render row
; size - pixel size
; col - column offset
; px - offset x
; py - offset y
; scale - scaling
; row - row position
(proc render_row size col px py scale row
(sym x r7)
(sym y r8)
(add y row)
(ld x col)
(:col)
(call pixel x y px py scale)
(sub r0 maxiter 1)
(rcmp res0 1 r0
(eq?
(mod r0 res0 16)
(bfrd r0 @GRADIENT r0)
)
(else? (ld r0 0))
)
(sc-rect x y size size r0)
(add x COL_SKIP)
(cmp x W)
(j.lt :col)
(sc-blit)
(ret)
)
(:loop)
(sc-poll)
; did_change -- did the user interact during this frame?
(ld did_change 0)
(sym pstep r2)
(sym zstep r3)
(ld pstep PAN_STEP)
(ld zstep ZOOM_STEP)
(sc-key _ KEY_ShiftL (nz?
; turbo mode
(fmul pstep 5.0)
(fmul zstep 5.0)
))
(fadd zstep 1.0)
; scaled movement speed
(fdiv pstep mb_s)
(tst is_first_render (z?
; A <
(sc-key _ KEY_A (nz?
(fsub mb_x pstep)
(ld did_change 1)
(lds @cout "Pan left\n")
))
; W ^
(sc-key _ KEY_W (nz?
(fsub mb_y pstep)
(ld did_change 1)
(lds @cout "Pan up\n")
))
; S v
(sc-key _ KEY_S (nz?
(fadd mb_y pstep)
(ld did_change 1)
(lds @cout "Pan down\n")
))
; D >
(sc-key _ KEY_D (nz?
(fadd mb_x pstep)
(ld did_change 1)
(lds @cout "Pan right\n")
))
; Q +
(sc-key r0 KEY_Q (nz?
(fmul mb_s zstep)
(ld did_change 1)
(lds @cout "Zoom in\n")
))
; E -
(sc-key r0 KEY_E (nz?
(fdiv mb_s zstep)
(ld did_change 1)
(lds @cout "Zoom out\n")
))
; R iter+
(sc-key r0 KEY_R (nz?
(add maxiter 50)
(lds @cout "ITER=") (call printnum maxiter) (ld @cout '\n')
(mslp 200) ; Avoid unexpected rapid change
))
; F iter-
(sc-key r0 KEY_F (nz?
(cmp maxiter 50)
(sub.gt maxiter 50)
(lds @cout "ITER=") (call printnum maxiter) (ld @cout '\n')
(mslp 200) ; Avoid unexpected rapid change
))
; G force redraw
(sc-key r0 KEY_G (nz?
(ld did_change 1)
))
(tst did_change (nz?
; something changed...
; mark this as a first render and reset col_skip and row_skip
(ld is_first_render 1)
(ld mb_skip_index 0)
; Start from top
(ld mb_row 0)
))
))
(unsym pstep)
(unsym zstep)
(sym mb_col_skip r2)
(sym mb_row_skip r3)
(bfrd mb_col_skip @mb_skip_table_x mb_skip_index)
(bfrd mb_row_skip @mb_skip_table_y mb_skip_index)
(bfrd r1 @mb_size_table mb_skip_index)
; render row mb_row + row skip
(ld r0 mb_row)
(add r0 mb_row_skip)
(call render_row r1 mb_col_skip mb_x mb_y mb_s r0)
(unsym mb_col_skip)
(unsym mb_row_skip)
(cmp mb_row H
(lt?
; if mb_row < H
(add mb_row ROW_SKIP)
)
(else?
; otherwise, this frame is done
(ld mb_row 0)
(add mb_skip_index 1)
(ld is_first_render 0)
(cmp mb_skip_index MB_SKIP_TABLE_SIZE (ge?
; if skip index is out of bounds, go back to repeating area
(ld mb_skip_index MB_SKIP_REPEAT_INDEX)
))
)
)
(j :loop)
(proc pixel xi yi off_x off_y scale
(sym x0 r7)
(sym y0 r8)
(itf x0 xi)
(itf y0 yi)
; Scale to the interesting range x -2.5..1 and y -1..1
(itf r0 W)
(itf r1 H)
(fdiv x0 r0)
(fmul x0 3.5)
(fsub x0 2.5)
(fdiv y0 r1)
(fmul y0 2.4)
(fsub y0 1.2)
(fdiv x0 scale)
(fdiv y0 scale)
(fadd x0 off_x)
(fadd y0 off_y)
(sym x r5)
(sym y r6)
(ld x 0.0)
(ld y 0.0)
(sym iter r4)
(:iter)
(cmp iter maxiter)
(j.eq :end)
(fmul r0 x x)
(fmul r1 y y)
(fadd r2 r1)
(fcmp r2 4.0)
(j.gt :end)
(fsub r2 r0 r1)
(fadd r2 x0)
(fmul r0 x y)
(fmul r0 2.0)
(fadd r0 y0)
(ld y r0)
(ld x r2)
(inc iter)
(j :iter)
(:end)
(ret iter)
)
(proc printnum num
(mkbf r15)
(ld r1 num)
(tst r1 (<0? (mul r1 -1)))
(:next)
(mod r0 r1 10)
(add r0 '0')
(bfrpush @r15 r0)
(div r1 10 (z?
(tst num (<0? (bfrpush @r15 '-')))
(lds @cout @r15)
(del @r15)
(ret)))
(j :next)
)
)