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

replace 'line' with Mu implementation

This commit is contained in:
Kartik K. Agaram 2021-07-05 17:58:08 -07:00
parent f32caac6df
commit 0b07a43367
2 changed files with 196 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
shell/data.limg
View File

@ -134,29 +134,6 @@
(hline1 scr y 0 (width scr) color)])
(vline . [def (vline scr x color)
(vline1 scr x 0 (height scr) color)])
(line . [def (line screen x0 y0 x1 y1 color)
with (x x0
y y0
dx (abs x1-x0)
dy (0 - (abs y1-y0))
sx (sgn x1-x0)
sy (sgn y1-y0))
let err dx+dy
while (not (and (x = x1)
(y = y1)))
(pixel screen x y color)
let e2 err*2
when (e2 >= dy)
x += sx
when (e2 <= dx)
y += sy
err +=
(+ (if (e2 >= dy)
dy
0)
(if (e2 <= dx)
dx
0))])
(read_line . [def (read_line keyboard)
ret str (stream)
let c (key keyboard)

205
shell/primitives.mu
View File

@ -38,6 +38,7 @@ fn initialize-primitives _self: (addr global-table) {
append-primitive self, "right"
append-primitive self, "cr"
append-primitive self, "pixel"
append-primitive self, "line"
append-primitive self, "width"
append-primitive self, "height"
# for keyboards
@ -56,7 +57,7 @@ fn initialize-primitives _self: (addr global-table) {
# evaluate all their arguments.
fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int {
var y/ecx: int <- copy ymax
y <- subtract 0x11/primitives-border
y <- subtract 0x10/primitives-border
clear-rect screen, xmin, y, xmax, ymax, 0xdc/bg=green-bg
y <- increment
var right-min/edx: int <- copy xmax
@ -98,7 +99,7 @@ fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int {
#? loop-if-=
#? }
y <- copy ymax
y <- subtract 0x10/primitives-border
y <- subtract 0xf/primitives-border
var left-max/edx: int <- copy xmax
left-max <- subtract 0x20/primitives-divider
var tmpx/eax: int <- copy xmin
@ -125,17 +126,13 @@ fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int {
tmpx <- draw-text-rightward screen, "pixel graphics", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
y <- increment
var tmpx/eax: int <- copy xmin
tmpx <- draw-text-rightward screen, " line pixel", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
y <- increment
var tmpx/eax: int <- copy xmin
tmpx <- draw-text-rightward screen, " width height", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
y <- increment
var tmpx/eax: int <- copy xmin
tmpx <- draw-text-rightward screen, " pixel", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
tmpx <- draw-text-rightward screen, ": screen x y color", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
y <- increment
var tmpx/eax: int <- copy xmin
tmpx <- draw-text-rightward screen, "screen/keyboard", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
y <- increment
var tmpx/eax: int <- copy xmin
tmpx <- draw-text-rightward screen, " clear", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
tmpx <- draw-text-rightward screen, ": screen", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
y <- increment
@ -436,6 +433,13 @@ fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr hand
apply-pixel args-ah, out, trace
return
}
{
var line?/eax: boolean <- string-equal? f-name, "line"
compare line?, 0/false
break-if-=
apply-line args-ah, out, trace
return
}
{
var width?/eax: boolean <- string-equal? f-name, "width"
compare width?, 0/false
@ -1932,6 +1936,189 @@ fn apply-pixel _args-ah: (addr handle cell), out: (addr handle cell), trace: (ad
# return nothing
}
fn apply-line _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
trace-text trace, "eval", "apply 'line'"
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
{
var args-type/eax: (addr int) <- get args, type
compare *args-type, 0/pair
break-if-=
error trace, "args to 'line' are not a list"
return
}
var empty-args?/eax: boolean <- nil? args
compare empty-args?, 0/false
{
break-if-=
error trace, "'line' needs 6 args but got 0"
return
}
# screen = args->left
var first-ah/eax: (addr handle cell) <- get args, left
var first/eax: (addr cell) <- lookup *first-ah
{
var first-type/eax: (addr int) <- get first, type
compare *first-type, 5/screen
break-if-=
error trace, "first arg for 'line' is not a screen"
return
}
var screen-ah/eax: (addr handle screen) <- get first, screen-data
var _screen/eax: (addr screen) <- lookup *screen-ah
var screen/edi: (addr screen) <- copy _screen
# x1 = args->right->left->value
var rest-ah/eax: (addr handle cell) <- get args, right
var _rest/eax: (addr cell) <- lookup *rest-ah
var rest/esi: (addr cell) <- copy _rest
{
var rest-type/eax: (addr int) <- get rest, type
compare *rest-type, 0/pair
break-if-=
error trace, "'line' encountered non-pair"
return
}
{
var rest-nil?/eax: boolean <- nil? rest
compare rest-nil?, 0/false
break-if-=
error trace, "'line' needs 6 args but got 1"
return
}
var second-ah/eax: (addr handle cell) <- get rest, left
var second/eax: (addr cell) <- lookup *second-ah
{
var second-type/eax: (addr int) <- get second, type
compare *second-type, 1/number
break-if-=
error trace, "second arg for 'line' is not a number (screen x coordinate of start point)"
return
}
var second-value/eax: (addr float) <- get second, number-data
var x1/edx: int <- convert *second-value
# y1 = rest->right->left->value
var rest-ah/eax: (addr handle cell) <- get rest, right
var _rest/eax: (addr cell) <- lookup *rest-ah
rest <- copy _rest
{
var rest-type/eax: (addr int) <- get rest, type
compare *rest-type, 0/pair
break-if-=
error trace, "'line' encountered non-pair"
return
}
{
var rest-nil?/eax: boolean <- nil? rest
compare rest-nil?, 0/false
break-if-=
error trace, "'line' needs 6 args but got 2"
return
}
var third-ah/eax: (addr handle cell) <- get rest, left
var third/eax: (addr cell) <- lookup *third-ah
{
var third-type/eax: (addr int) <- get third, type
compare *third-type, 1/number
break-if-=
error trace, "third arg for 'line' is not a number (screen y coordinate of start point)"
return
}
var third-value/eax: (addr float) <- get third, number-data
var y1/ebx: int <- convert *third-value
# x2 = rest->right->left->value
var rest-ah/eax: (addr handle cell) <- get rest, right
var _rest/eax: (addr cell) <- lookup *rest-ah
var rest/esi: (addr cell) <- copy _rest
{
var rest-type/eax: (addr int) <- get rest, type
compare *rest-type, 0/pair
break-if-=
error trace, "'line' encountered non-pair"
return
}
{
var rest-nil?/eax: boolean <- nil? rest
compare rest-nil?, 0/false
break-if-=
error trace, "'line' needs 6 args but got 3"
return
}
var fourth-ah/eax: (addr handle cell) <- get rest, left
var fourth/eax: (addr cell) <- lookup *fourth-ah
{
var fourth-type/eax: (addr int) <- get fourth, type
compare *fourth-type, 1/number
break-if-=
error trace, "fourth arg for 'line' is not a number (screen x coordinate of end point)"
return
}
var fourth-value/eax: (addr float) <- get fourth, number-data
var x2/ecx: int <- convert *fourth-value
# y2 = rest->right->left->value
var rest-ah/eax: (addr handle cell) <- get rest, right
var _rest/eax: (addr cell) <- lookup *rest-ah
rest <- copy _rest
{
var rest-type/eax: (addr int) <- get rest, type
compare *rest-type, 0/pair
break-if-=
error trace, "'line' encountered non-pair"
return
}
{
var rest-nil?/eax: boolean <- nil? rest
compare rest-nil?, 0/false
break-if-=
error trace, "'line' needs 6 args but got 4"
return
}
var fifth-ah/eax: (addr handle cell) <- get rest, left
var fifth/eax: (addr cell) <- lookup *fifth-ah
{
var fifth-type/eax: (addr int) <- get fifth, type
compare *fifth-type, 1/number
break-if-=
error trace, "fifth arg for 'line' is not a number (screen y coordinate of end point)"
return
}
var fifth-value/eax: (addr float) <- get fifth, number-data
var tmp/eax: int <- convert *fifth-value
var y2: int
copy-to y2, tmp
# color = rest->right->left->value
var rest-ah/eax: (addr handle cell) <- get rest, right
var _rest/eax: (addr cell) <- lookup *rest-ah
rest <- copy _rest
{
var rest-type/eax: (addr int) <- get rest, type
compare *rest-type, 0/pair
break-if-=
error trace, "'line' encountered non-pair"
return
}
{
var rest-nil?/eax: boolean <- nil? rest
compare rest-nil?, 0/false
break-if-=
error trace, "'line' needs 6 args but got 5"
return
}
var sixth-ah/eax: (addr handle cell) <- get rest, left
var sixth/eax: (addr cell) <- lookup *sixth-ah
{
var sixth-type/eax: (addr int) <- get sixth, type
compare *sixth-type, 1/number
break-if-=
error trace, "sixth arg for 'line' is not an int (color; 0..0xff)"
return
}
var sixth-value/eax: (addr float) <- get sixth, number-data
var color/eax: int <- convert *sixth-value
draw-line screen, x1, y1, x2, y2, color
# return nothing
}
fn apply-wait-for-key _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
trace-text trace, "eval", "apply 'key'"
var args-ah/eax: (addr handle cell) <- copy _args-ah