mirror of
https://gitlab.com/eql/lqml.git
synced 2025-12-06 02:30:38 -08:00
a bunch of revisions
This commit is contained in:
parent
1220bf06dc
commit
113386fdae
16 changed files with 109 additions and 112 deletions
|
|
@ -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)))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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()
|
||||
}
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue