akkartik
/
mu
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

clean up Bresenham line-drawing

This commit is contained in:
Kartik K. Agaram 2021-05-07 11:28:59 -07:00
parent 25eb9c580e
commit 91f76e6b22
2 changed files with 54 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
shell/data.limg
View File

@ -23,32 +23,28 @@
(hline1 screen y1 x1 x2 color)
(set y1 (+ y1 1)))))])
(brline . [(def brline (fn (screen x0 y0 x1 y1 color)
((fn (dx dy sx sy)
((fn (err)
(brline1 screen x0 y0 x1 y1 dx dy sx sy err color))
(+ dx dy)))
(abs (- x1 x0))
(- 0 (abs (- y1 y0)))
(sgn (- x1 x0))
(sgn (- y1 y0)))))])
(brline1 . [(def brline1 (fn (screen x y xlast ylast dx dy sx sy err color)
(while (not (and (= x xlast) (= y ylast)))
(let (x y) `(,x0 ,y0)
(let dx (abs (- x1 x0))
(let dy (- 0 (abs (- y1 y0)))
(let sx (sgn (- x1 x0))
(let sy (sgn (- y1 y0))
(let err (+ dx dy)
(while (not (and (= x x1)
(= y y1)))
(pixel screen x y color)
((fn (e2)
(if (>= e2 dy)
(set x (+ x sx))
())
(if (<= e2 dx)
(set y (+ y sy)))
(set err (+ err
(+
(if (>= e2 dy)
dy
0)
(if (<= e2 dx)
dx
0)))))
(* err 2)))))])
(let e2 (* err 2)
(when (>= e2 dy)
(set x (+ x sx)))
(when (<= e2 dx)
(set y (+ y sy)))
(set err
(+ err
(+ (if (>= e2 dy)
dy
0)
(if (<= e2 dx)
dx
0))))))))))))))])
(read_line_2 . [(def read_line_2 (fn (keyboard stream)
((fn (c)
(if (= c 10)
@ -97,5 +93,5 @@
(main . [(def main (fn (screen keyboard)
(chessboard screen 16)))])
))
(sandbox . (fill_rect screen 0 0 8 8 2))
(sandbox . (brline screen 1 1 5 5 4))
)

32
shell/global.mu
View File

@ -35,6 +35,7 @@ fn initialize-globals _self: (addr global-table) {
append-primitive self, "="
append-primitive self, "no"
append-primitive self, "not"
append-primitive self, "dbg"
# for pairs
append-primitive self, "car"
append-primitive self, "cdr"
@ -607,6 +608,13 @@ fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr hand
apply-not args-ah, out, trace
return
}
{
var debug?/eax: boolean <- string-equal? f-name, "dbg"
compare debug?, 0/false
break-if-=
apply-debug args-ah, out, trace
return
}
{
var lesser?/eax: boolean <- string-equal? f-name, "<"
compare lesser?, 0/false
@ -1181,6 +1189,30 @@ fn apply-not _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr
new-integer out, 1
}
fn apply-debug _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
trace-text trace, "eval", "apply debug"
var args-ah/eax: (addr handle cell) <- copy _args-ah
var _args/eax: (addr cell) <- lookup *args-ah
var args/esi: (addr cell) <- copy _args
# TODO: check that args is a pair
var empty-args?/eax: boolean <- nil? args
compare empty-args?, 0/false
{
break-if-=
error trace, "not needs 1 arg but got 0"
return
}
# dump args->left uglily to screen and wait for a keypress
var first-ah/eax: (addr handle cell) <- get args, left
dump-cell-from-cursor-over-full-screen first-ah
{
var foo/eax: byte <- read-key 0/keyboard
compare foo, 0
loop-if-=
}
# return nothing
}
fn apply-< _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
trace-text trace, "eval", "apply '<'"
var args-ah/eax: (addr handle cell) <- copy _args-ah