a bunch of revisions

This commit is contained in:
pls.153 2022-01-29 09:37:19 +01:00
parent 1220bf06dc
commit 113386fdae
16 changed files with 109 additions and 112 deletions

View file

@ -7,6 +7,12 @@
(defvar *canvas* "canvas")
(defvar *input* "input")
(defmacro with-path ((color &optional (line-width 14)) &body body)
`(progn
(qjs |begin| *canvas* ,color ,line-width)
,@body
(qjs |end| *canvas*)))
(defun draw-line (x1 y1 x2 y2)
(qjs |drawLine| *canvas*
x1 y1 x2 y2))
@ -16,33 +22,35 @@
(q! |requestPaint| *canvas*))
(defun paint ()
(draw-line 0 -150 0 150)
(let ((dy -50)
(dig 1))
(labels ((line (x1 y1 x2 y2)
(when (find dig '(2 4))
(setf x1 (- x1)
x2 (- x2)))
(when (>= dig 3)
(setf y1 (- y1)
y2 (- y2)
dy 50))
(draw-line (* 100 x1) (+ dy (* 100 y1))
(* 100 x2) (+ dy (* 100 y2))))
(draw (n)
(case n
(1 (line 0 -1 1 -1))
(2 (line 0 0 1 0))
(3 (line 0 -1 1 0))
(4 (line 0 0 1 -1))
(5 (draw 1) (draw 4))
(6 (line 1 -1 1 0))
(7 (draw 1) (draw 6))
(8 (draw 2) (draw 6))
(9 (draw 1) (draw 8)))))
(let ((num *number*))
(x:while (plusp num)
(draw (mod num 10))
(setf num (floor (/ num 10)))
(incf dig))))))
(with-path ("black")
(draw-line 0 -150 0 150))
(with-path ("blue")
(let ((dy -50)
(dig 1))
(labels ((line (x1 y1 x2 y2)
(when (find dig '(2 4))
(setf x1 (- x1)
x2 (- x2)))
(when (>= dig 3)
(setf y1 (- y1)
y2 (- y2)
dy 50))
(draw-line (* 100 x1) (+ dy (* 100 y1))
(* 100 x2) (+ dy (* 100 y2))))
(draw (n)
(case n
(1 (line 0 -1 1 -1))
(2 (line 0 0 1 0))
(3 (line 0 -1 1 0))
(4 (line 0 0 1 -1))
(5 (draw 1) (draw 4))
(6 (line 1 -1 1 0))
(7 (draw 1) (draw 6))
(8 (draw 2) (draw 6))
(9 (draw 1) (draw 8)))))
(let ((num *number*))
(x:while (plusp num)
(draw (mod num 10))
(setf num (floor (/ num 10)))
(incf dig)))))))

View file

@ -13,24 +13,33 @@ Rectangle {
width: 220
height: 320
property var painter
property var ctx
// functions to be called from Lisp
function begin(color, width) {
ctx.beginPath()
ctx.strokeStyle = color
ctx.lineWidth = width
ctx.lineCap = "round"
}
function end() {
ctx.stroke()
}
function drawLine(x1, y1, x2, y2) {
painter.moveTo(x1, y1)
painter.lineTo(x2, y2)
ctx.moveTo(x1, y1)
ctx.lineTo(x2, y2)
}
onPaint: {
var ctx = getContext("2d")
painter = ctx
ctx = getContext("2d")
ctx.reset()
ctx.strokeStyle = "blue"
ctx.lineWidth = 10
ctx.lineCap = "round"
ctx.translate(110, 160)
Lisp.call("qml-user:paint")
ctx.stroke()
}
}