I have started to build a small game in racket using the 2htdp/universe library. My code so far:
#lang racket
(require 2htdp/image 2htdp/universe)
(define BIRD-IMG (scale .2 (object:image% ...)) ; Image URL: http://i.stack.imgur.com/Vz26B.png
(struct world (bird) #:transparent)
(struct pos (x y) #:transparent)
(struct bird (pos img) #:transparent)
(define-values (WIDTH HEIGHT)
(values 600 600))
(define DEFAULT-STATE (world (bird (pos (/ WIDTH 2) (/ HEIGHT 2)) BIRD-IMG)))
(define (move-bird w x y dir)
(world
(bird
(pos
(let
([new-x (+ (pos-x (bird-pos (world-bird w))) x)]
[new-y (+ (pos-y (bird-pos (world-bird w))) y)])
(values
(cond
[(> new-x WIDTH) WIDTH]
[(< new-x 0) 0]
[else new-x])
(cond
[(> new-y HEIGHT) HEIGHT]
[(< new-y 0) 0]
[else new-y]))))
(case dir
[("up") BIRD-IMG]
[("down") (rotate 180 BIRD-IMG)]
[("left") (rotate 90 BIRD-IMG)]
[("right") (rotate -90 BIRD-IMG)]
[else (bird-img (world-bird w))]))))
(define (render w)
(place-image (bird-img (world-bird w))
(pos-x (bird-pos (world-bird w)))
(pos-y (bird-pos (world-bird w)))
(empty-scene WIDTH HEIGHT)))
(define (handle-keys w key)
(case key
[("up") (move-bird w 0 -5 key)]
[("down") (move-bird w 0 5 key)]
[("left") (move-bird w -5 0 key)]
[("right") (move-bird w 5 0 key)]
[else w]))
(big-bang DEFAULT-STATE
(on-draw render)
(on-key handle-keys)
(on-tick (lambda (w) w) 20)
(name "Bird Simulator 2016"))
My problem: When I try to press the arrow keys to move the bird in a direction, there is an error in the 'move-bird' function:
result arity mismatch;
expected number of values not received
expected: 1
received: 2
values...:
Running it through DrRacket's debugger, I can see that it is where the variables from the let have gone out of scope, but the program is at a lower level than the outermost world struct. I am confused because the arity mismatch error didn't name any particular place/function, and I certainly don't see any place where more values are given then are required. The world struct is passed only a bird struct, and the bird struct only a pos and an img. It might have to do with the let inside of the pos struct, but I am not sure. Please help!
Related
I am trying to create a program that consumes xyz, with digits in decreasing order, and produces 1089. I have to take xyz, reverse the digits, determine the difference between xyz and it's reverse and call it diff, add diff and it's reverse and then get the answer of 1089. I've been trying for hours but I am unable to figure out how to create the code. So far I have an attempt with only functions but I still can't get it to work. What am I doing wrong?:
1)
(define h 100)
(define t 10)
(define o 1)
(define (front xyz)
(number->string (substring xyz 0 1)))
(define (mid xyz)
(number->string (substring xyz 1 2)))
(define (back xyz)
(number->string (substring xyz 2 3)))
(define (reversexyz xyz)
(string->number (+ (* (back xyz) h) (* (mid xyz) t) (* (front xyz) o))))
(define (diff abc)
(- xyz (reversexyz)))
(define (frontdiff abc)
(number->string (substring frontdiff 0 1)))
(define (middiff abc)
(number->string (substring middiff 1 2)))
(define (backdiff abc)
(number->string (substring backdiff 2 3)))
(define (reversediff xyz)
(number->string (+ (* (backdiff abc) h) (* (middiff abc) t) (* (frontdiff abc) o))))
(define (magic xyz)
(+ diff reversediff))
Based on this explanation this should be as easy as:
(define (pad0 str) ; add leading 0's to a string, 3 characters wide
(~a #:width 3 #:align 'right #:left-pad-string "0" str))
(define (reverse-num n) ; reverse a number
(string->number (list->string (reverse (string->list (pad0 (number->string n)))))))
(define (magic xyz) ; the magic happens here
(define diff (abs (- (reverse-num xyz) xyz)))
(+ diff (reverse-num diff)))
Testing:
> (magic 123)
1089
> (magic 678)
1089
> (magic 321)
1089
> (magic 546)
1089
FWIW, after this modification, there are still 90 numbers between 100 and 999 (inclusive) where the algorithm doesn't work:
> (for/sum ((i (in-range 100 1000)) #:when (not (= (magic i) 1089))) 1)
90
I'm writing a scheme program that allows a user to create planets that follow gravitational laws. For the assignment, I have to alter the code to avoid busy waiting and also create a new thread for each planet, or every time that the mouse is clicked. I don't have a good understanding of GUIs in scheme, and would be very thankful for some help.
Here is the code:
#lang racket
(require racket/gui)
;; Small 2d vector library for the Newtonian physics
(define (x v) (vector-ref v 0))
(define (y v) (vector-ref v 1))
(define (x! v value) (vector-set! v 0 value))
(define (y! v value) (vector-set! v 1 value))
(define (v* v value) (vector-map (lambda (x) (* x value)) v))
(define (v+ v w) (vector-map + v w))
(define (v- v w) (vector-map - v w))
(define (v-zero! v) (vector-map! (lambda (x) 0) v))
(define (v-dot v w) (let ((vw (vector-map * v w))) (+ (x vw) (y vw))))
(define (v-mag v) (sqrt (v-dot v v)))
;; Planet object
(define planet%
(class object%
(public m p v calculate-force move draw)
(init-field (mass 1)
(position (vector 0 0 ))
(velocity (vector 0 0 ))
(force (vector 0 0 )))
(define (m) mass)
(define (p) position)
(define (v) velocity)
;; Use Newton's law of gravitation.
;; I assume the gravitational constant is one
(define (calculate-force pl)
(v-zero! force)
(for-each (lambda (other-planet)
(when (not (equal? this other-planet))
(let* ((direction (v- (send other-planet p) position))
(dist (max 1 (v-mag direction)))
(other-mass (send other-planet m))
(new-force (v* direction (/ (* mass other-mass) (* dist dist))))
)
(vector-map! + force new-force))))
pl)
)
;; Simple Euler integration of acceleration and velocity
(define (move)
(let ((acc (v* force (/ 1.0 mass))))
(vector-map! + velocity acc)
(vector-map! + position velocity)))
;; Draw a circle
(define (draw dc)
(send dc set-brush brush)
(send dc set-pen pen)
(send dc draw-ellipse (x position) (y position) radius radius ))
;; Initialize to random velocity, mass, and color
(x! velocity (* 2 (random)))
(y! velocity (* 2 (random)))
(set! mass (+ 1 (* 10 (random))))
(define radius (* 5 (sqrt mass)))
(define color
(let* ((r (random))
(b (real->floating-point-bytes r 4)))
(make-object color% (bytes-ref b 0) (bytes-ref b 1) (bytes-ref b 2) )))
(define brush (make-object brush% color))
(define pen (make-object pen% color))
;; Don't forget the super-new!
(super-new)
))
;; Abstract the list-handling for a list of planets
(define planet-container%
(class object%
(public add-planet calculate-force move draw get-planets)
(init-field (planets '()))
(define (get-planets) planets)
(define (add-planet planet)
(set! planets (cons planet planets)))
(define (calculate-force)
(for-each (lambda (planet)
(send planet calculate-force planets))
planets))
(define (move)
(for-each (lambda (planet)
(send planet move))
planets))
(define (draw dc)
(for-each (lambda (planet)
(send planet draw dc))
planets))
(super-new)
)
)
(define planet-container (new planet-container%))
;; The GUI
(define frame (new frame%
(label "Planets")
(min-width 120)
(min-height 80)
))
(send frame create-status-line)
(send frame show #t)
(define h-panel
(new horizontal-panel%
(parent frame)
(stretchable-height #f)
(style '(border))
(border 2)))
(define run-checkbox
(new check-box%
(parent h-panel)
(label "Run animation")
))
(define my-canvas%
(class canvas%
(override on-paint on-event)
(define (on-paint)
(let ((dc (send this get-dc))
(w (send this get-width))
(h (send this get-height)))
(send dc clear)
(send planet-container draw dc)
))
(define (on-event event)
(when (send event button-down?)
(let ((x (send event get-x))
(y (send event get-y)))
(send frame set-status-text (format "Mouse at ~a ~a" x y))
(send planet-container add-planet (new planet% (position (vector x y))))
(send this refresh)))
)
(super-new)
(send (send this get-dc) set-background (make-object color% 8 8 64))
))
(define canvas
(new my-canvas%
(parent frame)
(style '(border))
(min-width 640)
(min-height 480)))
;; Busy loop planet animator
(let loop ()
(sleep/yield .05)
(when (send run-checkbox get-value)
(send planet-container calculate-force)
(send planet-container move)
(send canvas refresh)
)
(loop))
Here's the crucial bit of code:
(define ch (make-channel))
(define run-checkbox
(new check-box%
(parent h-panel)
(label "Run animation")
[callback (λ _ (channel-put ch (send run-checkbox get-value)))]))
(thread (λ ()
(define moving? #f)
(let loop ()
;; either get a message on ch, or wait for 50 ms
(define r (sync ch (alarm-evt (+ (current-inexact-milliseconds) 50))))
;; if we got a message, update the state
(when (boolean? r) (set! moving? r))
;; move things if necessary
(when moving?
(send planet-container calculate-force)
(send planet-container move)
(send canvas refresh))
(loop))))
We first create a channel to communicate between the checkbox and the update thread.
Then, whenever there's a click on the checkbox, we send the value of the checkbox over the channel.
In the thread, we keep track of whether we're moving or not with the moving? variable. The thread simply sits in a loop updating the canvas whenever we're in the "moving" state.
To check for new messages, we use sync. The call to sync will return a result either if there's a message on ch (either #t or #f) or the alarm-evt finishes (in 50 milliseconds). If we actually got a message, ie a boolean message on the channel, we update which state we're in, update the canvas if necessary, and go back around the loop.
I'm trying to make a procedure that uses image-map to change the color of a image according to a range. Like this:
If the sum of the RGB channels for one pixel = 0 to 181 then the color would be (0 51 76)
If the sum = 182 to 363 then the color would be (217 26 33)
If the sum = 364 to 545 then the color would be (112 150 158)
If the sum = 546 to 765 then the color would be (252 227 166)
Now, here's what I have so far:
(define (sum p)
(image-map
(lambda (c)
(+ (color-ref c 'red) (color-ref c 'green) (color-ref c 'blue)))
p))
(define color-range
(lambda (c)
(cond
[(< (sum c) 181) (color 0 51 76)]
[(and (>= (sum c) 182) (<= (sum c) 363)) (color 217 26 33)]
[(and (>= (sum c) 364) (<= (sum c) 545)) (color 112 150 158)]
[(and (>= (sum c) 546) (<= (sum c) 765)) (color 252 227 166)])))
So, I made a helper function to calculate the sum of each pixel. When I run color-range, I get an error saying that:
Exception in image-map: #[color 255 255 255] is not the correct type, expected image
Help?
Thanks!
What's the expected input for sum, a pixel or an image? if it's a pixel, why traverse it using image-map? if it's an image, why adding all the color components of all its pixels and setting that as a new pixel?
I believe this is closer to what you intended (I can't tell for sure with just the snippet of code currently in the question); also notice that I fixed a couple of bugs in color-range:
(define sum
(lambda (c)
(+ (color-ref c 'red)
(color-ref c 'green)
(color-ref c 'blue))))
(define color-range
(lambda (c)
(cond
[(<= 0 (sum c) 181) (color 0 51 76)]
[(<= 182 (sum c) 363) (color 217 26 33)]
[(<= 364 (sum c) 545) (color 112 150 158)]
[else (color 252 227 166)])))
(define change-colors
(lambda (image)
(image-map (lambda (pixel)
(color-range pixel))
image)))
Of course, the above can be further optimized (for example, by removing the multiple calls to sum, and passing color-range directly to image-map, etc.) but first, let's make sure that the above works and that you understand what it's doing.
You are conflating images and colors (you are calling sum with a color but sum expects an image, it seems). Be more explicit with your types. For example:
(define (color-intensity c)
(+ (color-ref c 'red) (color-ref c 'green) (color-ref c 'blue)))
(define (remap-color c)
(let ((intensity (color-intensity c)))
(cond [(<= 0 intensity 181) ...]
[(<= 182 intensity 363) ...]
...)))
(define (remap-image i)
(image-map remap-color i))
I'm writing a scheme program for an assignment that creates "planets" when the user clicks, and starts/stops the planets from orbiting each other when a checkbox is clicked. We are supposed to implement this with a thread. However, thread-suspend does not seem to work when I click the checkbox, but resume does.
Thanks for any help you can offer! Here is the code:
#lang racket
(require racket/gui)
(require racket/block)
;; Small 2d vector library for the Newtonian physics
(define (x v) (vector-ref v 0))
(define (y v) (vector-ref v 1))
(define (x! v value) (vector-set! v 0 value))
(define (y! v value) (vector-set! v 1 value))
(define (v* v value) (vector-map (lambda (x) (* x value)) v))
(define (v+ v w) (vector-map + v w))
(define (v- v w) (vector-map - v w))
(define (v-zero! v) (vector-map! (lambda (x) 0) v))
(define (v-dot v w) (let ((vw (vector-map * v w))) (+ (x vw) (y vw))))
(define (v-mag v) (sqrt (v-dot v v)))
(define sem (make-semaphore))
;; Planet object
(define planet%
(class object%
(public m p v calculate-force move draw)
(init-field (mass 1)
(position (vector 0 0 ))
(velocity (vector 0 0 ))
(force (vector 0 0 )))
(define (m) mass)
(define (p) position)
(define (v) velocity)
;; Use Newton's law of gravitation.
;; I assume the gravitational constant is one
(define (calculate-force planet-list)
(v-zero! force)
(for-each (lambda (other-planet)
(when (not (equal? this other-planet))
(let* ((direction (v- (send other-planet p) position))
(dist (max 1 (v-mag direction)))
(other-mass (send other-planet m))
(new-force (v* direction (/ (* mass other-mass) (* dist dist))))
)
(vector-map! + force new-force))))
planet-list)
)
;; Simple Euler integration of acceleration and velocity
(define (move)
(let ((acc (v* force (/ 1.0 mass))))
(vector-map! + velocity acc)
(vector-map! + position velocity)))
;; Draw a circle
(define (draw dc)
(send dc set-brush brush)
(send dc set-pen pen)
(send dc draw-ellipse (x position) (y position) radius radius ))
;; Initialize to random velocity, mass, and color
(x! velocity (random))
(y! velocity (random))
(set! mass (+ 1 (* 10 (random))))
(define radius (* 5 (sqrt mass)))
(define color
(let* ((r (random))
(b (real->floating-point-bytes r 4)))
(make-object color% (bytes-ref b 0) (bytes-ref b 1) (bytes-ref b 2) )))
(define brush (make-object brush% color))
(define pen (make-object pen% color))
;; Don't forget the super-new!
(super-new)
))
;; Abstract the list-handling for a list of planets
(define planet-list%
(class object%
(public add-planet calculate-force move draw)
(init-field (planets '()))
(define (add-planet planet)
(set! planets (cons planet planets)))
(define (calculate-force)
(for-each (lambda (planet)
(send planet calculate-force planets))
planets))
(define (move)
(for-each (lambda (planet)
(send planet move))
planets))
(define (draw dc)
(for-each (lambda (planet)
(send planet draw dc))
planets))
(super-new)
)
)
(define planet-list (new planet-list%))
;; The GUI
(define frame (new frame%
(label "Planets")
(min-width 120)
(min-height 80)
))
(send frame create-status-line)
(send frame show #t)
(define h-panel
(new horizontal-panel%
(parent frame)
(stretchable-height #f)
(style '(border))
(border 2)))
(define run-checkbox
(new check-box%
(parent h-panel)
(label "Run animation")
(callback
(lambda (button event)
(cond [(send run-checkbox get-value)(thread-resume (thread-a))]
[(not (send run-checkbox get-value)) (thread-suspend (thread-a))]
)))
))
(define my-canvas%
(class canvas%
(override on-paint on-event)
(define (on-paint)
(let ((dc (send this get-dc))
(w (send this get-width))
(h (send this get-height)))
(send dc clear)
(send planet-list draw dc)
))
(define (on-event event)
(when (send event button-down?)
(let ((x (send event get-x))
(y (send event get-y)))
(send frame set-status-text (format "Mouse at ~a ~a" x y))
(send planet-list add-planet (new planet% (position (vector x y))))
(send this refresh)))
)
(super-new)
(send (send this get-dc) set-background (make-object color% 8 8 64))
))
(define canvas
(new my-canvas%
(parent frame)
(style '(border))
(min-width 640)
(min-height 480)))
;; planet animator
(define thread-a (lambda ()
(let loop ()
(sleep/yield .1)
(send planet-list calculate-force)
(send planet-list move)
(send canvas refresh)
(loop))))
; this creates the thread-a and starts the program
(thread-suspend (thread thread-a))
It's actually miraculous that you got this working as much as it does.
The problem is that thread-a is not a thread. It's not a function that produces a thread. It's a function that runs forever, moving planets around and updating the canvas.
So when your checkbox's callback does (thread-suspend (thread-a)), for example, the thread-suspend never actually happens. The call to thread-a just starts running and never returns.
The reason the GUI doesn't lock up (which it normally would if an event callback didn't return) is that thread-a periodically calls sleep/yield, which allows the GUI event loop to process more events. (That's why I said the code is miraculous.)
The fix is to define thread-a as the thread itself:
(define thread-a
(thread
(lambda ()
(let loop () ....))))
(thread-suspend thread-a)
and change the other references from (thread-a) to just thread-a.
We have some functions needed to be called at any time and places. For example:
(defun winG (qty pb ps)
(- (* qty ps (- 1 SXF YHS)) (* 2 GHF) (* qty pb (+ 1 SXF))))
(defun winQ (qty pb ps)
(- (* qty ps (- 1 SXF)) (* 2 GHF) (* qty pb (+ 1 SXF))))
(defun stopLoss (qty pb &optional (lossRate 0.02))
(let ((tot (* qty pb (+ 1 SXF))))
(format t "Stop Loss at:~$~%" (- pb (/ (* tot lossRate) qty)))
(format t "Lost Money:~$(~d%)~%" (* tot lossRate) (* 100 lossRate))))
(defun div618 (p1 p2)
(let ((ratio '(0. 0.191 0.236 0.382 0.5 0.618 0.809 1.))
(price #'(lambda (r) (if (<= p1 p2) (+ p1 (* (- p2 p1) r)) (- p1 (* (- p1 p2) r))))))
(if (<= p1 p2)
(dolist (r (reverse ratio)) (format t "-------~3$ ~$-------~%" r (funcall price r)))
(dolist (r ratio) (format t "-------~3$ ~$-------~%" r (funcall price r))))))
Now we use stumpwm which can load our functions once started and we can call those functions just by striking hot key to open its eval window at any time and places. It is VERY convenient. However, the stumpwm is not VERY steady as xmonad. So we want to use xmonad instead of stumpwm and we donot mind to implement those Common Lisp functions using haskell.
Any suggestion is appreciated!
you should be able to do this via something like this
myKeys conf#(XConfig {XMonad.modMask = modm}) = M.fromList $
[ ((modm, xK_F1 ), spawn $ XMonad.terminal conf) --starts the terminal
, ((mod4Mask,xK_F1 ), spawn "gvim" >> -- you can concatenate commands too
spawn "notify-send -t 1000 gVim" >>
focusUrgent) -- or haskell functions
, ((mod4Mask,xK_F2 ), spawn "lisp evaluate lispy function")
, ((modm, xK_F3 ), haskellFunctionPortedFromLisp )]
hope this helps.