vecto drawing a pixel

[Jim Newton]

I need to calculate the filling of some shapes I've drawn, which
I do not believe vecto can do by itself.

https://www.xach.com/lisp/vecto

My algorithm is to scan all the x,y points in the bounding-box of the
figure I've drawn, I calculate myself based on my application logic
whether or not the pixel should be colored or not. Then I want to
draw a pixel at that x,y.

The only way I see to do this is to draw a 1x1 rectangle, which seems
like a lot of work as the documentation for says that a rectangle
consists of all the following.

(move-to x y)
(line-to (+ x width) y)
(line-to (+ x width) (+ y height))
(line-to x (+ y height))
(close-subpath)


Is there an easier way to draw a point in vecto?

[tar...@google.com]

From my quick perusal of the documentation, it seems that VECTO and the
underlying CL-VECTORS package are designed for vector-based graphics and
not point- or pixel-based graphics. That being said, you might find something
in one of the underlying packages that would help. Although I'm not sure
exactly how the different levels would interact.

If nothing else, it seems like the CL-VECTORS tutorial uses a put-pixel
function, although it is described as only intended for use in the tutorial.
But looking at that code could possibly give you some ideas.

I guess there is also the ZPNG library used by vecto, if you want to do direct
image manipulation.

[Pascal J. Bourguignon]

Yes. But points have no size. So there's no way to see them, even if you
assign them a color.

And even if you draw an infinite number of points inside an give area,
you still won't see the color, because there are more infinite points in
that area that are not colored!

Your logic is confusing points and pixels.

Also, pixels are something that (is very strange looking) is on screen
displays. Take a magnifier and have a look at them!
https://www.youtube.com/watch?v=wJgNk-kDrK0

Since each screen has different pixel sizes and shapes, you definitely
don't want to work with pixels.

Instead, draw your vectorial picture in terms of geometric shapes, and
then let the system map this vectorial picture to the actual screen
pixels (the rasterisation). Doing that, you will save about 40 years of
pain.


--
__Pascal J. Bourguignon
http://www.informatimago.com

[Jim Newton]

Another drawback of my approach, is that when I fill a huge amount of areas,
sbcl runs out of memory.

My code has a loop which generates 10 or so different png files.
Each iteration draws some circles (about 10) onto the canvas and fills (colorizes the interior)
of certain intersections between some of the shapes. It does so by calculating based on
the underlying geometry, but maps to the grid and pixel size I've declared in the
(with-canvas (:width ... :height ...) ...)
Finally the iteration saves the png with (save-png...)

If I simply try to run these 10 loops generating 10 png files, sbcl usually runs out of memory and dies.
However, if I call (gc :full t) at the end of each loop, it works fine and the memory usage stays
pretty reasonable.

This work-around lets me create the graphic files I need.

[Thibault Langlois]

Why don't you use the fill-path function ?

Once I needed to draw vecto graphics on a png image. I ended by loading the image using imago and copy it to the canvas, accessing the underlying zpng object:

(defun copydata (from to)
(loop
for i below (array-dimension from 0)
do (loop
for j below (array-dimension from 1)
do (loop
for k below (array-dimension from 2)
do
(setf (aref to i j k)
(aref from i j k))))))

(defun copy-background (background-image)
(let ((foreground (zpng:data-array (vecto::image vecto::*graphics-state*))))
(copydata background-image foreground)))

it worked because this was the first operation on the canvas.

[Pascal J. Bourguignon]

I would use row-major-aref, or displaced arrays:

(defun copy-array-1 (from to)
(assert (equal (array-dimensions from) (array-dimensions to)))
(loop :for i :below (reduce (function *) (array-dimensions from))
:do (setf (row-major-aref to i) (row-major-aref from i)))
to)

(defun copy-array-2 (from to)
(assert (equal (array-dimensions from) (array-dimensions to)))
(let ((size (reduce (function *) (array-dimensions from))))
(replace (make-array size :element-type (array-element-type to)
:displaced-to to)
(make-array size :element-type (array-element-type from)
:displaced-to from)))
to)

(let ((to-1 (make-array '(4 3 2) :element-type '(unsigned-byte 8)))
(to-2 (make-array '(4 3 2) :element-type '(unsigned-byte 8)))
(from (make-array '(4 3 2) :element-type '(unsigned-byte 8)
:initial-contents '(((11 12) (13 14) (15 16))
((21 22) (23 24) (25 26))
((31 32) (33 34) (35 36))
((41 42) (43 44) (45 46))))))
(values (copy-array-1 from to-1)
(copy-array-2 from to-2)))

--> #3A(((11 12) (13 14) (15 16)) ((21 22) (23 24) (25 26)) ((31 32) (33 34) (35 36)) ((41 42) (43 44) (45 46)))
#3A(((11 12) (13 14) (15 16)) ((21 22) (23 24) (25 26)) ((31 32) (33
#34) (35 36)) ((41 42) (43 44) (45 46)))


--
__Pascal J. Bourguignon__
http://www.informatimago.com

[Thibault Langlois]

Thanks Pascal,
I haven't seen before an example of displaced arrays.
I thought that both your solution would be more computationally efficient than my naive nested loops (plus the fact that they work with any array dimensions) but to my surprise it is not the case:

(using sbcl)

BKGD> (time (test1))
Evaluation took:
35.516 seconds of real time
35.489418 seconds of total run time (34.880809 user, 0.608609 system)
[ Run times consist of 0.051 seconds GC time, and 35.439 seconds non-GC time. ]
99.92% CPU
74,453,682,561 processor cycles
2,000,000,144 bytes consed

T
BKGD> (time (test2))
Evaluation took:
44.510 seconds of real time
44.523308 seconds of total run time (44.135496 user, 0.387812 system)
[ Run times consist of 0.022 seconds GC time, and 44.502 seconds non-GC time. ]
100.03% CPU
93,283,811,676 processor cycles
2,000,000,144 bytes consed

T
BKGD> (time (test3))

Evaluation took:
28.526 seconds of real time
28.528670 seconds of total run time (28.200749 user, 0.327921 system)
[ Run times consist of 0.024 seconds GC time, and 28.505 seconds non-GC time. ]
100.01% CPU
59,774,786,371 processor cycles
2,000,000,144 bytes consed

where test1,2,3 are:

(defun test1 ()
(let ((a1 (make-array '(1000 1000 1000) :element-type '(unsigned-byte 8)
:initial-element 1))
(a2 (make-array '(1000 1000 1000) :element-type '(unsigned-byte 8)
:initial-element 2)))
(copy-array-1 a1 a2))
t)

(defun test2 ()
(let ((a1 (make-array '(1000 1000 1000) :element-type '(unsigned-byte 8)
:initial-element 1))
(a2 (make-array '(1000 1000 1000) :element-type '(unsigned-byte 8)
:initial-element 2)))
(copy-array-2 a1 a2))
t)

(defun test3 ()
(let ((a1 (make-array '(1000 1000 1000) :element-type '(unsigned-byte 8)
:initial-element 1))
(a2 (make-array '(1000 1000 1000) :element-type '(unsigned-byte 8)
:initial-element 2)))
(copydata a1 a2))
t)

[Pascal J. Bourguignon]

Thibault Langlois <thibault...@gmail.com> writes:

> I haven't seen before an example of displaced arrays.
> I thought that both your solution would be more computationally
> efficient than my naive nested loops (plus the fact that they work
> with any array dimensions) but to my surprise it is not the case:
>
> (using sbcl)

Here are the results I get for the other implementations (your numbers
for sbcl):

| implementation | row-major-aref | replace+displaced | aref | best |
|----------------+----------------+-------------------+--------+-------------------|
| abcl (64MB) | 0.912 | 4.54 | 4.665 | row-major-aref |
| ccl | 51.729 | 28.204 | 47.139 | replace+displaced |
| clisp (16MB) | 0.711 | 0.029 | 1.063 | replace+displaced |
| ecl | 17.272 | 0.193 | 14.057 | replace+dispalced |
| sbcl | 36.516 | 44.510 | 28.526 | aref |

the size of the test arrays has been reduced for abcl and clisp to fit
array-total-size-limit or (default) heap size limit.

replace+displaced is faster in most implementations, because they get to
optimize the inner loop in replace.

The result for replace+displaced by ecl is strange, but a2 is indeed
filled with only 1s after test2… and:
(time (find 1 (make-array 1000000000 :displaced-to *r* :element-type '(unsigned-byte 8)) :test '/=))
real time : 23.863

What an optimization!

[Spiros Bousbouras]

On Fri, 30 Nov 2018 23:50:26 +0100
"Pascal J. Bourguignon" <p...@informatimago.com> wrote:
> Thibault Langlois <thibault...@gmail.com> writes:
>
> > I haven't seen before an example of displaced arrays.
> > I thought that both your solution would be more computationally
> > efficient than my naive nested loops (plus the fact that they work
> > with any array dimensions) but to my surprise it is not the case:
> >
> > (using sbcl)
>
> Here are the results I get for the other implementations (your numbers
> for sbcl):
>
> | implementation | row-major-aref | replace+displaced | aref | best |
> |----------------+----------------+-------------------+--------+-------------------|
> | abcl (64MB) | 0.912 | 4.54 | 4.665 | row-major-aref |
> | ccl | 51.729 | 28.204 | 47.139 | replace+displaced |
> | clisp (16MB) | 0.711 | 0.029 | 1.063 | replace+displaced |
> | ecl | 17.272 | 0.193 | 14.057 | replace+dispalced |
> | sbcl | 36.516 | 44.510 | 28.526 | aref |
>
> the size of the test arrays has been reduced for abcl and clisp to fit
> array-total-size-limit or (default) heap size limit.
>
> replace+displaced is faster in most implementations, because they get to
> optimize the inner loop in replace.
>
> The result for replace+displaced by ecl is strange, but a2 is indeed
> filled with only 1s after test2… and:

Could you show us the output of
(disassemble 'test2)
?

> (time (find 1 (make-array 1000000000 :displaced-to *r* :element-type '(unsigned-byte 8)) :test '/=))

What is *r* ?

[Pascal J. Bourguignon]

(defvar *r*)
(defun test2 ()
(let ((a1 (make-array '(#-(or abcl clisp) 1000 #+clisp 16 #+abcl 64 1000 1000) :element-type '(unsigned-byte 8)
:initial-element 1))
(a2 (make-array '(#-(or abcl clisp) 1000 #+clisp 16 #+abcl 64 1000 1000) :element-type '(unsigned-byte 8)

:initial-element 2)))
(copy-array-2 a1 a2)

(setf *r* a2))
t)

>> real time : 23.863
>>
>> What an optimization!

I used:

ecl -norc
(load (compile-file #P"~/b.lisp"))
(time (test1))
(time (test2))
(time (test3))
(find 1 (make-array 1000000000 :displaced-to *r* :element-type (array-element-type *r*)) :test '/=)

Using compile-file seem to have applied the C compiler.
If I use (load #P"~/b.lisp"), which allows to use diassmble, the timings
are as follow "ecl (bc)":

| implementation | row-major-aref | replace+displaced | aref | best |

|----------------+----------------+-------------------+---------+-------------------|

| abcl (64MB) | 0.912 | 4.54 | 4.665 | row-major-aref |
| ccl | 51.729 | 28.204 | 47.139 | replace+displaced |
| clisp (16MB) | 0.711 | 0.029 | 1.063 | replace+displaced |

| ecl (cmp) | 17.272 | 0.193 | 14.057 | replace+dispalced |
| ecl (bc) | 132.108 | 0.205 | 176.943 | replace+dispalced |

| sbcl | 36.516 | 44.510 | 28.526 | aref |

I would guess that in both cases, it comes down to a builtin memcpy.

This is on a iMac with 4 x 8GB banks of 1867 MHz DDR3, and 4 GHz Intel
Core i7.

So one could expect a minimum copy time for 1e9 bytes to be:
(/ 1000000000.0 8 (/ 1867000000.0 2)) - 0.134 s.


However, a built-in memcpy could do much better, by using the DMA,
duplicating only the page descriptors, marking them COW, and sharing the
storage between the two arrays. Then the actual copy would occur only
as one array or the other is mutated. Since gcc builtin memcpy doesn't
do it, any CL implementation could perform this optimization, for big arrays…



Otherwise, disassemble on ecl is not that informative since it only
works for the bytecode, not for the C code:

[pjb@despina org.macports:0 ~]$ ecl -norc
ECL (Embeddable Common-Lisp) 16.1.3 (git:UNKNOWN)
Copyright (C) 1984 Taiichi Yuasa and Masami Hagiya
Copyright (C) 1993 Giuseppe Attardi
Copyright (C) 2000 Juan J. Garcia-Ripoll
Copyright (C) 2016 Daniel Kochmanski
ECL is free software, and you are welcome to redistribute it
under certain conditions; see file 'Copyright' for details.
Type :h for Help.
Top level in: #<process TOP-LEVEL>.
> (load (compile-file "~/b.lisp"))

;;; Loading #P"/opt/local/lib/ecl-16.1.3/cmp.fas"
;;;
;;; Compiling /Users/pjb/b.lisp.
;;; OPTIMIZE levels: Safety=2, Space=0, Speed=3, Debug=0
;;;
;;; Compiling (DEFUN COPY-ARRAY-1 ...).
;;; Compiling (DEFUN COPY-ARRAY-2 ...).
;;; Compiling (DEFUN COPYDATA ...).
;;; Compiling (DEFUN TEST1 ...).
;;; Compiling (DEFVAR *R*).
;;; Compiling (DEFUN TEST2 ...).
;;; Compiling (DEFUN TEST3 ...).
;;; End of Pass 1.
;;; Emitting code for COPY-ARRAY-1.
;;; Emitting code for COPY-ARRAY-2.
;;; Emitting code for COPYDATA.
;;; Emitting code for TEST1.
;;; Emitting code for TEST2.
;;; Emitting code for TEST3.
;;; Finished compiling /Users/pjb/b.lisp.
;;;
;;; Loading "/Users/pjb/b.fas"
#P"/Users/pjb/b.fas"
> (disassemble 'test2)
;;; Warning: Cannot disassemble the binary function #<compiled-function TEST2> because I do not have its source code.

NIL
> (load #P"~/b.lisp")

;;; Loading "/Users/pjb/b.lisp"
#P"/Users/pjb/b.lisp"
> (disassemble 'test2)

#(TEST2 (1000 1000 1000) :ELEMENT-TYPE (UNSIGNED-BYTE 8) :INITIAL-ELEMENT MAKE-ARRAY (1000 1000 1000) (UNSIGNED-BYTE 8) A2 A1 COPY-ARRAY-2 *R* T #<bytecompiled-function TEST2> SI:FSET)
Name: TEST2
0 NOMORE
1 PUSH '(1000 1000 1000)
3 PUSHVS :ELEMENT-TYPE
5 PUSH '(UNSIGNED-BYTE 8)
7 PUSHVS :INITIAL-ELEMENT
9 PUSH 1
11 CALLG 5,MAKE-ARRAY
14 PUSH VALUES(0)
15 PUSH '(1000 1000 1000)
17 PUSHVS :ELEMENT-TYPE
19 PUSH '(UNSIGNED-BYTE 8)
21 PUSHVS :INITIAL-ELEMENT
23 PUSH 2
25 CALLG 5,MAKE-ARRAY
28 PUSH VALUES(0)
29 PBIND A2
31 PBIND A1
33 PUSHV 0
35 PUSHV 1
37 CALLG 2,COPY-ARRAY-2
40 VAR 1
42 SETQS *R*
44 UNBIND 2
46 VARS T
48 SET VALUES(0),REG0
49 EXIT
NIL
> (disassemble 'copy-array-2)

#(COPY-ARRAY-2 FROM TO (EQUAL (ARRAY-DIMENSIONS FROM) (ARRAY-DIMENSIONS TO)) SI:ASSERT-FAILURE ARRAY-DIMENSIONS EQUAL * REDUCE SIZE :ELEMENT-TYPE ARRAY-ELEMENT-TYPE :DISPLACED-TO MAKE-ARRAY REPLACE #<bytecompiled-function COPY-ARRAY-2> SI:FSET)
Name: COPY-ARRAY-2
0 POP REQ
1 BIND FROM
3 POP REQ
4 BIND TO
6 NOMORE
7 JMP 14
9 PUSH '(EQUAL (ARRAY-DIMENSIONS FROM) (ARRAY-DIMENSIONS TO))
11 CALLG 1,ASSERT-FAILURE
14 VAR 1
16 CALLG1 ARRAY-DIMENSIONS
18 PUSH VALUES(0)
19 VAR 0
21 CALLG1 ARRAY-DIMENSIONS
23 CALLG2 EQUAL
25 NOT
26 JT 9
28 SYMFUNC *
30 PUSH VALUES(0)
31 VAR 1
33 CALLG1 ARRAY-DIMENSIONS
35 PUSH VALUES(0)
36 CALLG 2,REDUCE
39 BIND SIZE
41 PUSHV 0
43 PUSHVS :ELEMENT-TYPE
45 VAR 1
47 CALLG1 ARRAY-ELEMENT-TYPE
49 PUSH VALUES(0)
50 PUSHVS :DISPLACED-TO
52 PUSHV 1
54 CALLG 5,MAKE-ARRAY
57 PUSH VALUES(0)
58 PUSHV 0
60 PUSHVS :ELEMENT-TYPE
62 VAR 2
64 CALLG1 ARRAY-ELEMENT-TYPE
66 PUSH VALUES(0)
67 PUSHVS :DISPLACED-TO
69 PUSHV 2
71 CALLG 5,MAKE-ARRAY
74 PUSH VALUES(0)
75 CALLG 2,REPLACE
78 UNBIND 1
80 VAR 0
82 SET VALUES(0),REG0
83 EXIT
NIL