gimp - creating layers 2d list - layer

Hello I am trying to convert a bunch of layers ( drawables + masks ) into a 2d list for random access using list-ref. I have failed and I cant see where I am going wrong. The cmyk-list contains garbage. All drawables have been tested with this example template (gimp-invert magenta-layer-copy) before creating the list Your help, comments appreciated.
(set! layerList (cadr (gimp-image-get-layers image)))
(set! number-of-layers (vector-length layerList))
(set! cyan-layer-copy (aref layerList (- number-of-layers 4)))
(set! cyan-mask-copy (car (gimp-layer-get-mask cyan-layer-copy)))
(set! magenta-layer-copy (aref layerList (- number-of-layers 3)))
(set! magenta-mask-copy (car (gimp-layer-get-mask magenta-layer-copy)))
(set! yellow-layer-copy (aref layerList (- number-of-layers 2)))
(set! yellow-mask-copy (car (gimp-layer-get-mask yellow-layer-copy)))
(set! alpha-layer-copy (aref layerList (- number-of-layers 1)))
(set! cmyk-list '((cyan-layer-copy cyan-mask-copy)
(magenta-layer-copy magenta-mask-copy)
(yellow-layer-copy yellow-mask-copy)
(alpha-layer-copy 0)))

Related

Iterating through a nested list using filter or fold Racket

I need to iterate through a list with sublists in Racket using list iteration and filtering, one of the lists is a nested list, I tried using "list?" and "car" to iterate inside but of course that would only apply to the first value of the sublist.
Is there a way to iterate through the whole nested list using list iteration and filtering?
(define (count-evens lst)
(length
(filter
(lambda (x)
(cond
[(and (list? x)
(and (number? (car x))
(eq? (modulo (car x) 2) 0)))
#t]
[(and (number? x)
(eq? (modulo x 2) 0))
#t]
[else
#f]))
lst)))
(count-evens '(1 2 5 4 (8 4 (b (10 3 3))) 3))
=> 3
Should return => 5
I would use a recursive function to do this but the assignment doesn't allow it.
"...assignment doesn't allow [recursive functions]"
Not sure what is allowed for this assignment, but
in ye olden days we processed recursive data structures with stacks...
(define (count-evens lst)
(define (lst-at stack) ;; (car stack) = index in deepest sub-list
;; produce list cursor within lst indexed by stack
(do ([stack (reverse stack) (cdr stack)]
[cursor (list lst) (list-tail (car cursor) (car stack))])
((null? stack) cursor)))
(do ([stack (list 0)
(cond
[(null? (lst-at stack))
(cdr stack)] ;; pop stack
[(pair? (car (lst-at stack)))
(cons 0 stack)] ;; push stack
[else ;; step through current (sub)list
(cons (+ 1 (car stack)) (cdr stack))])]
[count 0
(let ([item (car (lst-at stack))])
(if (and (number? item) (even? item)) (+ 1 count) count))])
((null? (lst-at stack)) count)))
> (count-evens '(1 2 5 4 (8 4 (b (10 3 3))) 3)) ;=>
5

Two racket modules colliding

I am requiring two modules to my file:
(require sicp) ; contains set-car! and set-cdr!
(require (planet dyoo/sicp-concurrency:1:2/sicp-concurrency)) ; contains procedures parallel-execute and test-and-set!
Problem: both libraries use different flavors of scheme. The sicp-concurrency uses mzscheme. Requiring this module prevented me from using else in a cond clause.
Is there a way to prevent the features of mzscheme in sicp-concurrency while still making use of the procedures I needed?
I have updated Danny Yoo's code to Racket 7.
Get the new file "sicp-concurrency.rkt" here:
https://gist.github.com/soegaard/d32e12d89705c774b71ee78ef930a4bf
Save the file in the same folder as your program file.
Here is an example of use:
#lang sicp
(#%require "sicp-concurrency.rkt")
(define (test-1)
(define x 10)
(parallel-execute (lambda () (set! x (* x x)))
(lambda () (set! x (+ x 1))))
x)
(define (test-2)
(define x 10)
(define s (make-serializer))
(parallel-execute (s (lambda () (set! x (* x x))))
(s (lambda () (set! x (+ x 1)))))
x)
(test-1)
(test-1)
(test-1)
(test-1)
(test-1)

draw new object onto existing canvas in Scheme using paint-callback

Some background, I'm making Space Invaders as a project in a CS class. Currently I'm working on making the player ship shoot projectiles, not worrying about collisions, just spawning projectiles.
(define projectile%
(class object%
(init-field [image (make-bitmap 10 10)]
[x 100]
[y 100]
[speed 1])
(define/public (get-image) image)
(define/private (move-up)
(set! y (- y speed)))
(define/public (render dc)
(let ((w (send image get-width))
(h (send image get-height)))
(move-up)
(send dc translate (+ x (/ w 2)) (+ y (/ h 2)))
(send dc draw-bitmap image (- (/ w 2)) (- (/ h 2)))
(send dc translate (- (+ x (/ w 2))) (- (+ y (/ h 2))))))
(super-new)))
(define player-ship%
(class object%
(init-field [image (make-bitmap 30 25)]
[x 400]
[y 300]
[speed 3])
(define/public (get-image) image)
(define/public (get-x) x)
(define/public (get-y) y)
(define/private (shoot)
;Spawning a projectile would go here
(define/public (render dc)
(let ((w (send image get-width))
(h (send image get-height)))
(send dc translate (+ x (/ w 2)) (+ y (/ h 2)))
(send dc draw-bitmap image (- (/ w 2)) (- (/ h 2)))
(send dc translate (- (+ x (/ w 2))) (- (+ y (/ h 2))))))
(define/public (key-down key-code)
(cond ((equal? key-code 'left) (move-left))
((equal? key-code 'right) (move-right))
((equal? key-code 'up) (shoot))))
(super-new)))
Those are the two relevant classes, some failed code for spawning a projectile removed.
Some code for how I'm drawing the window and stuff:
(define *my-game-canvas*
(new game-canvas%
[parent *game-window*]
[paint-callback (lambda (canvas dc)
(begin
(send *my-ship* render dc)
(send *ship-projectile* render dc)))]
[keyboard-handler (lambda (key-event)
(let ((key-code (send key-event get-key-code)))
(if (not (equal? key-code 'release))
(send *my-ship* key-down key-code))))]))
(define *my-timer* (new timer%
[notify-callback (lambda ()
(send *my-game-canvas* refresh))]))
(make-ship-projectile (send *ship-projectile* get-image))
;creating a projectile just seeing whether they work or not
(make-ship (send *my-ship* get-image))
The make-ship and make-ship-projectile functions work as follows:
(define (make-ship-projectile bitmap-target)
(let ((dc (new bitmap-dc% [bitmap bitmap-target])))
(send dc set-brush (make-object brush% "black" 'solid))
(send dc draw-ellipse 0 0 10 10)))
The problem arises when I try to create a new projectile with the shoot method in player-ship%, it simply doesn't work. I'm currently under the assumption that it doesn't work due to the new projectile not being in my-game-canvas's paint-callback, however, I do not know how to update that attribute. Am I approaching it from the wrong direction?
Yes, if the drawing of the projectile is not triggered from paint-callback (or another function/method called from it), it will not be displayed in the canvas when the canvas is refreshed.
One possibility is to have a list of existing projectiles (possibly an attribute in player-ship%), and paint-callback should trigger (possibly via player-ship%'s render method, or via a different method in player-ship% like render-projectiles that is called from the paint-callback) the display of all these projectiles in the canvas. When a new projectile is shot from the ship, it should be added to the list of existing projectiles and when the projectile hits something or escapes the board, it should be removed from this list.

Lilypond: how to add the number of repetitions above a bar

I am working with a score in Lilypond that has a lot of repetitions, where basically every bar has to be repeated a certain number of times. I would like to be able to write above every bar the number of times it should be repeat, similar to the score below (which was not created in Lilypond):
It would be great to be able to have some brackets above the bar and also to have the "3x" centralized, just like in the example above. So far, the only (temporary) solution I was able to come up with in Lilypond was to add repeat bars and then simply write "3x" above the first note of every bar (since I could not have it centralized on the bar either). It does not look very good, but gets the job done. This temporary solution looks like this:
Any suggestions of how to make this example look more similar to the first inn Lilypond would be extremely welcome!
This is a workaround for this problem:
\version "2.19.15"
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% COPY ALL THIS BELOW %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% repeatBracket snippet
% will add .----Nx----. above a bar, where N is the number of repetitions
% based on the wonderful spanner by David Nalesnik (see: http://lists.gnu.org/archive/html/lilypond-user/2014-10/msg00446.html )
#(define (test-stencil grob text)
(let* ((orig (ly:grob-original grob))
(siblings (ly:spanner-broken-into orig)) ; have we been split?
(refp (ly:grob-system grob))
(left-bound (ly:spanner-bound grob LEFT))
(right-bound (ly:spanner-bound grob RIGHT))
(elts-L (ly:grob-array->list (ly:grob-object left-bound 'elements)))
(elts-R (ly:grob-array->list (ly:grob-object right-bound 'elements)))
(break-alignment-L
(filter
(lambda (elt) (grob::has-interface elt 'break-alignment-interface))
elts-L))
(break-alignment-R
(filter
(lambda (elt) (grob::has-interface elt 'break-alignment-interface))
elts-R))
(break-alignment-L-ext (ly:grob-extent (car break-alignment-L) refp X))
(break-alignment-R-ext (ly:grob-extent (car break-alignment-R) refp X))
(num
(markup text))
(num
(if (or (null? siblings)
(eq? grob (car siblings)))
num
(make-parenthesize-markup num)))
(num (grob-interpret-markup grob num))
(num-stil-ext-X (ly:stencil-extent num X))
(num-stil-ext-Y (ly:stencil-extent num Y))
(num (ly:stencil-aligned-to num X CENTER))
(num
(ly:stencil-translate-axis
num
(+ (interval-length break-alignment-L-ext)
(* 0.5
(- (car break-alignment-R-ext)
(cdr break-alignment-L-ext))))
X))
(bracket-L
(markup
#:path
0.1 ; line-thickness
`((moveto 0.5 ,(* 0.5 (interval-length num-stil-ext-Y)))
(lineto ,(* 0.5
(- (car break-alignment-R-ext)
(cdr break-alignment-L-ext)
(interval-length num-stil-ext-X)))
,(* 0.5 (interval-length num-stil-ext-Y)))
(closepath)
(rlineto 0.0
,(if (or (null? siblings) (eq? grob (car siblings)))
-1.0 0.0)))))
(bracket-R
(markup
#:path
0.1
`((moveto ,(* 0.5
(- (car break-alignment-R-ext)
(cdr break-alignment-L-ext)
(interval-length num-stil-ext-X)))
,(* 0.5 (interval-length num-stil-ext-Y)))
(lineto 0.5
,(* 0.5 (interval-length num-stil-ext-Y)))
(closepath)
(rlineto 0.0
,(if (or (null? siblings) (eq? grob (last siblings)))
-1.0 0.0)))))
(bracket-L (grob-interpret-markup grob bracket-L))
(bracket-R (grob-interpret-markup grob bracket-R))
(num (ly:stencil-combine-at-edge num X LEFT bracket-L 0.4))
(num (ly:stencil-combine-at-edge num X RIGHT bracket-R 0.4)))
num))
#(define-public (Measure_attached_spanner_engraver context)
(let ((span '())
(finished '())
(event-start '())
(event-stop '()))
(make-engraver
(listeners ((measure-counter-event engraver event)
(if (= START (ly:event-property event 'span-direction))
(set! event-start event)
(set! event-stop event))))
((process-music trans)
(if (ly:stream-event? event-stop)
(if (null? span)
(ly:warning "You're trying to end a measure-attached spanner but you haven't started one.")
(begin (set! finished span)
(ly:engraver-announce-end-grob trans finished event-start)
(set! span '())
(set! event-stop '()))))
(if (ly:stream-event? event-start)
(begin (set! span (ly:engraver-make-grob trans 'MeasureCounter event-start))
(set! event-start '()))))
((stop-translation-timestep trans)
(if (and (ly:spanner? span)
(null? (ly:spanner-bound span LEFT))
(moment<=? (ly:context-property context 'measurePosition) ZERO-MOMENT))
(ly:spanner-set-bound! span LEFT
(ly:context-property context 'currentCommandColumn)))
(if (and (ly:spanner? finished)
(moment<=? (ly:context-property context 'measurePosition) ZERO-MOMENT))
(begin
(if (null? (ly:spanner-bound finished RIGHT))
(ly:spanner-set-bound! finished RIGHT
(ly:context-property context 'currentCommandColumn)))
(set! finished '())
(set! event-start '())
(set! event-stop '()))))
((finalize trans)
(if (ly:spanner? finished)
(begin
(if (null? (ly:spanner-bound finished RIGHT))
(set! (ly:spanner-bound finished RIGHT)
(ly:context-property context 'currentCommandColumn)))
(set! finished '())))
(if (ly:spanner? span)
(begin
(ly:warning "I think there's a dangling measure-attached spanner :-(")
(ly:grob-suicide! span)
(set! span '())))))))
\layout {
\context {
\Staff
\consists #Measure_attached_spanner_engraver
\override MeasureCounter.font-encoding = #'latin1
\override MeasureCounter.font-size = 0
\override MeasureCounter.outside-staff-padding = 2
\override MeasureCounter.outside-staff-horizontal-padding = #0
}
}
repeatBracket = #(define-music-function
(parser location N note)
(number? ly:music?)
#{
\override Staff.MeasureCounter.stencil =
#(lambda (grob) (test-stencil grob #{ #(string-append(number->string N) "×") #} ))
\startMeasureCount
\repeat volta #N { $note }
\stopMeasureCount
#}
)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ...UNTIL HERE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
{
\repeatBracket 7 {c'1}
\repeatBracket 32 {d' g}
\repeatBracket 14 {e' f g}
\repeatBracket 29 {f' a bes \break cis' e''}
\repeatBracket 1048 {g'1}
}
This code above gives the following result:
]
This solution was not created by myself, but sent to me by David Nalesnik, from lilypond-user mailing list. I just would like to share it here in case someone would need it as well. I've made just some very minor adjustments to what David sent me.
I just had a similar problem but preferred the style on your second example, with the 3x above the bar. The solution I found was:
f e d c |
\mark \markup {"3x"}\repeat volta 3 {c d e f}
f e d c |
generating
Maybe someone else has a use for it.

Prevent recursive function from reallocating a new variable

One of my task in programming class is "Tower Of Hanoi" , the language I was using is Common Lisp and the source code is as follow :
The Code :
Variables:
(defparameter *Source* "Peg 1")
(defparameter *Spare* "Peg 2")
(defparameter *Destination* "Peg 3")
I want the above variable declaraction to be inside the function
(defun towers-of-hanoi (disks)
;disks accept list as parameter , for e.g `(s m l)
(let ((tempPeg))
(if (= (list-length disks) 1)
(format t "Move ~{~A~} from ~A to ~A~%"
(last disks) *Source* *Destination*)
(progn
(setq tempPeg *Spare*)
(setq *Spare* *Destination*)
(setq *Destination* tempPeg)
(towers-of-hanoi (subseq disks 0 (- (list-length disks) 1)))
(setq tempPeg *Spare*)
(setq *Spare* *Destination*)
(setq *Destination* tempPeg)
(format t "Move ~{~A~} from ~A to ~A~%"
(last disks) *Source* *Destination*)
(setq tempPeg *Spare*)
(setq *Spare* *Source*)
(setq *Source* tempPeg)
(towers-of-hanoi (subseq disks 0 (- (list-length disks) 1)))
(setq tempPeg *Spare*)
(setq *Spare* *Source*)
(setq *Source* tempPeg)
(format t "")))))
The Question :
1.)I'm using recursive algorithm to solve this problem , as I know in this algorithm , the 3 variables (Source , Spare and Destination) must interchange with each other (by some rules) . If I place the defvar inside the function , even though I carry out this 3 operations (setq tempPeg *Spare*) (setq *Spare* *Destination*) (setq *Destination* tempPeg) before calling the towers-of-hanoi function again but the function again redefine the 3 variables back through it's original value .
2.)What I wanted to know is that is it possible for me to place the declaraction of the 3 variables inside the function and still able to prevent the function from redefining the same variable for each recursive called?
P/S the assignment only allows me to define a function header that accept disks as the one and only argument but not the Source , Spare , and Destination rod.
There are probably two good options here. The first is that since the function depends on a few values, the function could take them as arguments. That's probably the clearest way to do what you're trying to do, and it makes the recursive calls cleaner, because you don't need to rebind or assign a bunch of variables before making the call. For instance, here's a simple recursive function:
(defun swap-until-x-is-zero (x y)
(print `(swap-until-zero ,x ,y))
(unless (zerop x)
(swap-until-x-is-zero (1- y) (1- x))))
CL-USER> (swap-until-x-is-zero 3 5)
(SWAP-UNTIL-ZERO 3 5)
(SWAP-UNTIL-ZERO 4 2)
(SWAP-UNTIL-ZERO 1 3)
(SWAP-UNTIL-ZERO 2 0)
(SWAP-UNTIL-ZERO -1 1)
(SWAP-UNTIL-ZERO 0 -2)
NIL
Now, if that's supposed to start with some reasonable default values, then those function arguments could be made optional:
(defun swap-until-x-is-zero (&optional (x 3) (y 5))
(print `(swap-until-zero ,x ,y))
(unless (zerop x)
(swap-until-x-is-zero (1- y) (1- x))))
and then you can simply call (swap-until-x-is-zero):
CL-USER> (swap-until-x-is-zero)
(SWAP-UNTIL-ZERO 3 5)
(SWAP-UNTIL-ZERO 4 2)
(SWAP-UNTIL-ZERO 1 3)
(SWAP-UNTIL-ZERO 2 0)
(SWAP-UNTIL-ZERO -1 1)
(SWAP-UNTIL-ZERO 0 -2)
It should be clear how this approach could be applied to the Hanoi problem; you'd simply add three optional arguments to the hanoi and recursively call it with the altered values:
(defun towers-of-hanoi (disks &optional (source "Peg 1") (spare "Peg 2") (destination "Peg 3"))
...
;; instead of:
;; (progn
;; (setq tempPeg *Spare*)
;; (setq *Spare* *Destination*)
;; (setq *Destination* tempPeg)
;; (towers-of-hanoi (subseq disks 0 (- (list-length disks) 1))))
;; we do:
(let ((tempPeg spare))
(towers-of-hanoi (subseq disks 0 (- (list-length disks) 1))
source ; stays the same
destination ; swap destination and spare
spare)) ; swap destination and spare
...)
That said, sometimes there are enough parameters that it's easier to just use special variables (i.e., dynamically scoped variables) for them (though I don't think that this is such a case), and to get those, you can use the special declaration:
(defun towers-of-hanoi (disks)
(declare (special *source* *spare* *destination*))
(let ((tempPeg))
(if (= (list-length disks) 1)
(format t "Move ~{~A~} from ~A to ~A~%" (last disks) *Source* *Destination*)
(progn
(setq tempPeg *Spare*)
(setq *Spare* *Destination*)
(setq *Destination* tempPeg)
(towers-of-hanoi (subseq disks 0 (- (list-length disks) 1)))
...))))
You'll still have to establish the initial bindings of the variables, though, so for the outermost call you'd have to do something like:
(defun hanoi-driver (disks)
(let ((*source* "Peg 1")
(*spare* "Peg 2")
(*destination* "Peg 3"))
(declare (special *source* *spare* *destination*))
(hanoi disks)))
I think that that simply adding the three &optional variables to hanoi is ultimately a cleaner solution, personally.
Your use of lists is not idiomatic. Remember lists in Lisp are singly linked cons cells. All operations which traverse lists or work from the end of lists are inefficient.
To answer your question:
(defun do-something (a)
(let ((foo 42)) ; binding
(labels ((do-something-recursively (b) ; local recursive function
(...)))
(do-something-recursively a))))