diff --git a/shell/data.limg b/shell/data.limg index dd40fbdc..f276e9b5 100644 --- a/shell/data.limg +++ b/shell/data.limg @@ -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)) ) diff --git a/shell/global.mu b/shell/global.mu index 21076549..4cf17de3 100644 --- a/shell/global.mu +++ b/shell/global.mu @@ -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