I'm rather new at using GIMP's script-fu, and I'm working on a script to go through a full folder of .tif image files, resize them to having a dimension a maximum size of 1200 pixels while maintaining the proportions of the image. It then will save the file as a .png filetype.
The problem I've encountered and can't seem to find an answer for is:
Error: (: 1) car: argument 1 must be: pair
From what I can tell, it's saying that I'm trying to find the first entry of a list that doesn't have contents, but I don't see any further instances where this would be an issue. I've been pouring over numerous sites for help on this and tinkering with the script for around a while now, so I think it's time to ask for help. Unfortunately GIMP's documentation isn't very robust from what I can tell. Am I missing a car() somewhere that's still causing this error or is it referring to something more ambiguous now?
Thanks in advance...
(script-fu-register
"batchresize"
"Batch Resize"
"Resizes all images in folder to the desired maximum size and saves as .png"
"name"
"(c) 2017"
"March 2017"
""
SF-VALUE "Maximum Dimension" "1200"
SF-STRING "Target Folder" "/Scripts/Input/*.tif"
)
(script-fu-menu-register "batchresize" "<Image>/File/Batch"
)
(define
(batchresize maximum targetfolder
)
(let*
(
(filelist
(car
(file-glob targetfolder 1
)
)
)
(width 1200
)
(height 1200
)
)
(while
(not
(null? filelist
)
)
(let*
(
(filename
(car filelist
)
)
(image
(car
(gimp-file-load RUN-NONINTERACTIVE filename filename
)
)
)
(drawable
(car
(gimp-image-get-active-layer image
)
)
)
)
(Set! width car(gimp-image-width)
)
(Set! height car(gimp-image-height)
)
(if
(> height width
)
(set! proportion
(/ width height
)
)
(set! height maximum
)
(set! width
(* maximum proportion
)
)
(if
(< height width
)
(set! proportion
(/ height width
)
)
(set! width maximum
)
(set! height
(* maximum proportion
)
)
(if
(= height width
)
(set! height maximum
)
(set! width maximum
)
)
(gimp-image-scale-full image width height INTERPOLATION-CUBIC
)
(file-png-save RUN-NONINTERACTIVE image drawable filename filename 1 0 0 0 0 0 0
)
)
(gimp-image-delete image
)
)
(set! filelist
(cdr filelist
)
)
)
)
)
)
Related
Is there a way to save variables of the “first corner point” and “other corner point” when a user picks first point, then types in the length and width (with dynamic input on) when using the “Rectangle” command?
Example:
Command: RECTANGLE
Specify first corner point or [Chamfer/Elevation/Fillet/Thickness/Width]:
Specify other corner point or [Area/Dimensions/Rotation]: #20',15'
I want to replace what I have below with the “Rectangle” command so user can type in length and width they need. The user will prefer the length and width to be whole numbers (Ex: 13, 15, 20, 23...etc) which can be done if using the rectangle command. Right now they have to draw a rectangle they want in whole numbers first. Then use the routine and snap to the corners. Hoping to combine all in one routine.
What I have now:
(setq firstpick (getpoint "\nEnter first corner: "))
(setq secondpick (getcorner firstpick "\nEnter cross corner: "))
; Get all four corners of user drawn rectangle
(setq pt1 firstpick)
(setq pt3 secondpick)
(setq pt2 (list (car pt1) (cadr pt3)))
(setq pt4 (list (car pt3) (cadr pt1)))
; Get the Area drawn and save in variable “myrecarea”
(setq mylength (distance pt1 pt2)); length
(setq mywidth (distance pt1 pt4)); width
(setq myrecarea (* mylength mywidth)); Get area of rectangle (length x width)
I want to replace with using the “Rectangle” command (if possible) so user can type in length and width. Not sure how to replace with rectangle command, extract those corner points and save as variables...
(setq firstpick (command "rectangle"))(?)
(setq secondpick (?)
; Get all four corners of user drawn rectangle
(setq pt1 firstpick)
(setq pt3 secondpick)
(setq pt2 (list (car pt1) (cadr pt3)))
(setq pt4 (list (car pt3) (cadr pt1)))
; Get the Area drawn and save in variable “myrecarea”
(setq mylength (distance pt1 pt2)); length
(setq mywidth (distance pt1 pt4)); width
(setq myrecarea (* mylength mywidth)); Get area of rectangle (length x width)
*The Area size determines what is drawn later in the routine…
One last question,
Is it possible to save everything drawn in a routine in a block? Not sure how the block naming would work if routine run several times in a single drawing without overwriting the original block.
For the rectangle part, I tried this code below written by Kent1Cooper and it seems to work for what I need.
(defun C:RSCP () ; = Rectangle, Save Corner Points
(command-s "_.rectang"); [must be without Fillet or Chamfer options]
(setq
pt1 (vlax-curve-getPointAtParam (entlast) 0)
pt2 (vlax-curve-getPointAtParam (entlast) 1)
pt3 (vlax-curve-getPointAtParam (entlast) 2)
pt4 (vlax-curve-getPointAtParam (entlast) 3)
); setq
(princ)
); defun
Thanks Kent!
I'm learning Clojurescript while comparing it to Javascript and rewritting some scripts.
In Javascript I've created a canvas with a ball in it, that when it gets to the canvas' borders, it bounces back. I've made the same in Clojurescript, it works, but I need to create atoms outside the function, so I can keep track of the state. If I want to create more balls, I will need to replicate those atoms. At that point the code will be ugly. How should I change the code so I can create multiple balls and each with it's own state?
Here is the Javascript code:
// Circle object
function Circle(pos_x, pos_y, radius, vel_x, vel_y){
// Starting variables
this.radius = radius;
this.pos_x = pos_x;
this.pos_y = pos_y;
this.vel_x = vel_x;
this.vel_y = vel_y;
// Draw circle on the canvas
this.draw = function(){
c.beginPath();
c.arc(this.pos_x, this.pos_y, this.radius, 0, Math.PI * 2, false);
c.strokeStyle = this.color;
c.lineWidth = 5;
c.fillStyle = this.color_fill;
c.fill();
c.stroke();
};
// Update the circle variables each time it is called
this.update = function(){
// Check if it goes out of the width
if(this.pos_x + this.radius > canvas.width || this.pos_x - this.radius < 0){
// Invert velocity = invert direction
this.vel_x = -this.vel_x;
}
// Check if it goies out of the height
if(this.pos_y + this.radius > canvas.height || this.pos_y - this.radius < 0){
this.vel_y = -this.vel_y;
}
// Apply velocity
this.pos_x += this.vel_x;
this.pos_y += this.vel_y;
// Draw circle
this.draw();
};
};
// Create a single circle
let one_circle = new Circle(300, 300, 20, 1, 1);
function animate(){
requestAnimationFrame(animate);
// Clear canvas
c.clearRect(0, 0, canvas.width, canvas.height);
// Update all the circles
one_circle.update();
}
animate();
Here is the Clojurescript code:
(def ball-x (atom 300))
(def ball-y (atom 300))
(def ball-vel-x (atom 1))
(def ball-vel-y (atom 1))
(defn ball
[pos-x pos-y radius]
(.beginPath c)
(.arc c pos-x pos-y radius 0 (* 2 Math/PI))
(set! (.-lineWidth c) 5)
(set! (.-fillStyle c) "red")
(.fill c)
(.stroke c))
(defn update-ball
[]
(if (or (> (+ #ball-x radius) (.-width canvas)) (< (- #ball-x radius) 0))
(reset! ball-vel-x (- #ball-vel-x)))
(if (or (> (+ #ball-y radius) (.-height canvas)) (< (- #ball-y radius) 60))
(reset! ball-vel-y (- #ball-vel-y)))
(reset! ball-x (+ #ball-x #ball-vel-x))
(reset! ball-y (+ #ball-y #ball-vel-y))
(ball #ball-x #ball-y 20))
(defn animate
[]
(.requestAnimationFrame js/window animate)
(update-ball))
(animate)
Edit: I've tried a new approach to the problem, but this doesn't work. The ball is created, but it doesn't move.
(defrecord Ball [pos-x pos-y radius vel-x vel-y])
(defn create-ball
[ball]
(.beginPath c)
(.arc c (:pos-x ball) (:pos-y ball) (:radius ball) 0 (* 2 Math/PI))
(set! (.-lineWidth c) 5)
(set! (.-fillStyle c) "red")
(.fill c)
(.stroke c))
(def balls (atom {}))
(reset! balls (Ball. 301 300 20 1 1))
(defn calculate-movement
[ball]
(let [pos-x (:pos-x ball)
pos-y (:pos-y ball)
radius (:radius ball)
vel-x (:vel-x ball)
vel-y (:vel-y ball)
new-ball (atom {:pos-x pos-x :pos-y pos-y :radius radius :vel-x vel-x :vel-y vel-y})]
; Check if out of boundaries - width
(if (or (> (+ pos-x radius) (.-width canvas)) (< (- pos-x radius) 0))
(swap! new-ball assoc :vel-x (- vel-x)))
; Check if out of boundaries - height
(if (or (> (+ pos-y radius) (.-height canvas)) (< (- pos-y radius) 60))
(swap! new-ball assoc :vel-y (- vel-y)))
; Change `pos-x` and `pos-y`
(swap! new-ball assoc :pos-x (+ pos-x (#new-ball :vel-x)))
(swap! new-ball assoc :pos-x (+ pos-y (#new-ball :vel-y)))
(create-ball #new-ball)
(println #new-ball)
#new-ball))
(defn animate
[]
(.requestAnimationFrame js/window animate)
(reset! balls (calculate-movement #balls)))
(animate)
I'd maintain all of the balls as a collection in an atom. Each ball could be represented as a defrecord, but here we'll just keep them as maps. Let's define two balls:
(def balls (atom [{:pos-x 300
:pos-y 300
:radius 20
:vel-x 1
:vel-y 1}
{:pos-x 500
:pos-y 200
:radius 20
:vel-x -1
:vel-y 1}]))
I'd define a function that can draw a single ball:
(defn draw-ball [ball]
(let [{:keys [pos-x pos-y radius]} ball]
(set! (.-fillStyle c) "black")
(.beginPath c)
(.arc c pos-x pos-y radius 0 (* 2 Math/PI))
(.fill c)))
While we are at it, let's define a function to clear the canvas:
(defn clear-canvas []
(.clearRect c 0 0 (.-width canvas) (.-height canvas)))
Now, let's define a function that can update a single ball:
(defn update-ball [ball]
(let [{:keys [pos-x pos-y radius vel-x vel-y]} ball
bounce (fn [pos vel upper-bound]
(if (< radius pos (- upper-bound radius))
vel
(- vel)))
vel-x (bounce pos-x vel-x (.-width canvas))
vel-y (bounce pos-y vel-y (.-height canvas))]
{:pos-x (+ pos-x vel-x)
:pos-y (+ pos-y vel-y)
:radius radius
:vel-x vel-x
:vel-y vel-y}))
With the above, we can define our animate loop
(defn animate []
(.requestAnimationFrame js/window animate)
(let [updated-balls (swap! balls #(map update-ball %))]
(clear-canvas)
(run! draw-ball updated-balls)))
The key ideas are:
each entity (ball) is represented as a map
we have defined separate functions to draw and update the ball
everything is stored in a single atom
Some advantages:
the draw function is easy to test in isolation
the update function is easy to test at the REPL (arguably, it could be cleaned up further by passing in the canvas width and height, so that it is pure)
since all of the state is in a single atom, it is easy to reset! it with some new desired state (maybe to add new balls, or just for debugging purposes)
With the help of #Carcigenicate, this is a working script.
;;; Interact with canvas
(def canvas (.getElementById js/document "my-canvas"))
(def c (.getContext canvas "2d"))
;;; Set width and Height
(set! (.-width canvas) (.-innerWidth js/window))
(set! (.-height canvas) (.-innerHeight js/window))
(defrecord Ball [pos-x pos-y radius vel-x vel-y])
; Making the atom hold a list to hold multiple balls
(def balls-atom (atom []))
; You should prefer "->Ball" over the "Ball." constructor. The java interop form "Ball." has a few drawbacks
; And I'm adding to the balls vector. What you had before didn't make sense.
; You put an empty map in the atom, then immedietly overwrote it with a single ball
(doseq [ball (range 10)]
(swap! balls-atom conj (->Ball (+ 300 ball) (+ 100 ball) 20 (+ ball 1) (+ ball 1))))
; You called this create-ball, but it doesn't create anything. It draws a ball.
(defn draw-ball [ball]
; Deconstructing here for clarity
(let [{:keys [pos-x pos-y radius]} ball]
(.beginPath c)
(.arc c pos-x pos-y radius 0 (* 2 Math/PI))
(set! (.-lineWidth c) 5)
(set! (.-fillStyle c) "red")
(.fill c)
(.stroke c)))
(defn draw-balls [balls]
(doseq [ball balls]
(draw-ball ball)))
(defn out-of-boundaries
[ball]
"Check if ball is out of boundaries.
If it is, returns a new ball with inversed velocities."
(let [{:keys [pos-x pos-y vel-x vel-y radius]} ball]
;; This part was a huge mess. The calls to swap weren't even in the "if".
;; I'm using cond-> here. If the condition is true, it threads the ball. It works the same as ->, just conditionally.
(cond-> ball
(or (> (+ pos-x radius) (.-width canvas)) (< (- pos-x radius) 0))
(update :vel-x -) ; This negates the x velocity
(or (> (+ pos-y radius) (.-height canvas)) (< (- pos-y radius) 60))
(update :vel-y -)))) ; This negates the y velocity
; You're mutating atoms here, but that's very poor practice.
; This function should be pure and return the new ball
; I also got rid of the draw call here, since this function has nothing to do with drawing
; I moved the drawing to animate!.
(defn advance-ball [ball]
(let [{:keys [pos-x pos-y vel-x vel-y radius]} ball
; You had this appearing after the bounds check.
; I'd think that you'd want to move, then check the bounds.
moved-ball (-> ball
(update :pos-x + vel-x)
(update :pos-y + vel-y))]
(out-of-boundaries moved-ball)))
; For convenience. Not really necessary, but it helps things thread nicer using ->.
(defn advance-balls [balls]
(mapv advance-ball balls))
(defn animate
[]
(swap! balls-atom
(fn [balls]
(doto (advance-balls balls)
(draw-balls)))))
(animate)
I try batch-processing some files with GIMP.
Here is the script:
(define (script-fu-batch-sofu globexp)
(define (sofu-trans-img n f)
(let* ((fname (car f))
(img (car (gimp-file-load 1 fname fname))))
(gimp-image-undo-disable img)
(gimp-fuzzy-select (car (gimp-image-get-active-drawable img)) 0 0 10 2 FALSE FALSE 0 FALSE)
(gimp-selection-grow img 1)
(gimp-edit-clear (car (gimp-image-get-active-drawable img)))
(file-png-save-defaults non-interactive img (car (gimp-image-get-active-drawable img)) fname fname)
(gimp-image-delete img)
)
(if (= n 1) 1 (sofu-trans-img (- n 1) (cdr f)))
)
(set! files (file-glob globexp 0))
(sofu-trans-img (car files) (car (cdr files)))
)
; Im GIMP und im Menü registrieren
(script-fu-register "script-fu-batch-sofu"
_"_Mehrere Bilder transparentieren…"
_"Mehrere Bilder auf einmal transparent machen"
"Martin Weber"
"2012, Martin Weber"
"Sep 5, 2012"
""
SF-STRING "Zu transparentierende Dateien" "/pfad/zu/bildern/*.bmp")
(script-fu-menu-register "script-fu-batch-sofu" "<Image>/Xtns/Misc")
I basically copied a script from a tutorial and modified the lines where the image is processed.
If i run the script, i get this error message:
Error: set!: unbound variable: files
To be honest, i don't really know what that part does, but i think i need it.
I guess it opens the Files given by the script-parameter and precesses them one after the other.
I just don't know what is wrong there. What did i miss?
I think that you need to add
(define files)
at the first line of your code.
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.
So I have to finish a project in Scheme and I'm pretty stuck. Basically, what the program does is open a file and output the statistics. Right now I am able to count the number of characters, but I also need to count the number of lines and words. I'm just trying to tackle this situation for now but eventually I also have to take in two files - the first being a text file, like a book. The second will be a list of words, I have to count how many times those words appear in the first file. Obviously I'll have to work with lists but I would love some help on where to being. Here is the code that I have so far (and works)
(define filestats
(lambda (srcf wordcount linecount charcount )
(if (eof-object? (peek-char srcf ) )
(begin
(close-port srcf)
(display linecount)
(display " ")
(display wordcount)
(display " ")
(display charcount)
(newline) ()
)
(begin
(read-char srcf)
(filestats srcf 0 0 (+ charcount 1))
)
)
)
)
(define filestatistics
(lambda (src)
(let ((file (open-input-file src)))
(filestats file 0 0 0)
)
)
)
How about 'tokenizing' the file into a list of lines, where a line is a list of words, and a word is a list of characters.
(define (tokenize file)
(with-input-from-file file
(lambda ()
(let reading ((lines '()) (words '()) (chars '()))
(let ((char (read-char)))
(if (eof-object? char)
(reverse lines)
(case char
((#\newline) (reading (cons (reverse (cons (reverse chars) words)) lines) '() '()))
((#\space) (reading lines (cons (reverse chars) words) '()))
(else (reading lines words (cons char chars))))))))))
once you've done this, the rest is trivial.
> (tokenize "foo.data")
(((#\a #\b #\c) (#\d #\e #\f))
((#\1 #\2 #\3) (#\x #\y #\z)))
The word count algorithm using Scheme has been explained before in Stack Overflow, for example in here (scroll up to the top of the page to see an equivalent program in C):
(define (word-count input-port)
(let loop ((c (read-char input-port))
(nl 0)
(nw 0)
(nc 0)
(state 'out))
(cond ((eof-object? c)
(printf "nl: ~s, nw: ~s, nc: ~s\n" nl nw nc))
((char=? c #\newline)
(loop (read-char input-port) (add1 nl) nw (add1 nc) 'out))
((char-whitespace? c)
(loop (read-char input-port) nl nw (add1 nc) 'out))
((eq? state 'out)
(loop (read-char input-port) nl (add1 nw) (add1 nc) 'in))
(else
(loop (read-char input-port) nl nw (add1 nc) state)))))
The procedure receives an input port as a parameter, so it's possible to apply it to, say, a file. Notice that for counting words and lines you'll need to test if the current char is either a new line character or a white space character. And an extra flag (called state in the code) is needed for keeping track of the start/end of a new word.