(require 2htdp/image)
(require 2htdp/universe)
(define (box-letter letter-size target-letter target-letter-color fill-color outline-color)
(overlay/align "center" "center"
(cond
[(and(number? letter-size)(string? fill-color))
(square letter-size letter-size "solid" outline-color)])
(overlay/align
(cond
[(and(string? target-letter)(string? target-letter-color))
(square letter-size "solid" fill-color)])
(cond
[(and(string? target-letter)(string? target-letter-color))
(text(number->string target-letter)letter-size target-letter-color target-letter)]))))
Related
I am trying to make a text mover, which is the text will move to where I clicked. Also, when I press "left" key, I can change the color of the text. I think I finished each part the program needs, but I don't know how to put them together now :( I am still confused about how to use on-mouse function.
This is the position of the text part:
(require 2htdp/image)
(require 2htdp/universe)
(define POSN-0 (make-posn 50 50))
(define POSN-1 (make-posn 200 200))
(define POSN-2 (make-posn 100 100))
(define (posn-temp p)
(... (posn-x p) ...
(posn-y p) ...))
This is the color part:
(define Red "red")
(define Black "black")
(define Purple "purple")
(check-expect (RBP Red) "red")
(check-expect (RBP Black) "black")
(check-expect (RBP Purple) "purple")
(define (RBP c)
(cond
[(string=? c Red) "red"]
[(string=? c Black) "black"]
[(string=? c Purple) "purple"]))
This part provides all the information needed for the text-mover application, but I don't know how to use it？？
(define-struct tm [str pos col])
(define T1(make-tm "apple" 10 "red"))
(define T2(make-tm "banana" 20 "black"))
(define (tm-temp tm)
(... (tm-str tm) ...
(tm-pos tm) ...
(tm-col tm) ...))
To-draw:
(define bg (square 400 "solid" "white"))
(check-expect
(draw-tm POSN-0)
(place-image
(text "POG!"
25
"red")
50 50
bg))
(define (draw-tm c)
(place-image
(text "POG!"
25
(RBP c))
50 50
bg))
On-key:
(define (change-c c ke)
(cond
[(key=? ke "left") (RBP c)]
[else c]))
On-mouse:
(define (move-tm c )
(cond
[(mouse=? ) ]
[else c]))
Big-bang:
(define (move-text initial-tm)
(big-bang initial-tm
[to-draw draw-tm]
[on-mouse move-tm]
[on-key change-c]))
Read on-mouse description: function called with on-mouse has arguments state x y event and different types of mouse events are described in Mouse event docs. In your case, you will need "button-up" or "drag".
Also, when x or y or color changes, you have to create new instance of struct which represents state, using data from old instance.
Here is example code- run it with (move-text "FooBar"), you can drag displayed text into new position or change color with left key.
(require 2htdp/image)
(require 2htdp/universe)
(define-struct text-state [text position color])
(define (next-color color)
(second (assoc color (list (list "black" "red")
(list "red" "purple")
(list "purple" "black")))))
(define bg (square 400 "solid" "white"))
(define (draw-state state)
(place-image
(text (text-state-text state)
25
(text-state-color state))
(posn-x (text-state-position state))
(posn-y (text-state-position state))
bg))
(define (change-color state key)
(if (key=? key "left")
(make-text-state (text-state-text state)
(text-state-position state)
(next-color (text-state-color state)))
state))
(define (mouse-fn state x y event)
(if (string=? "drag" event)
(make-text-state
(text-state-text state)
(make-posn x y)
(text-state-color state))
state))
(define (move-text text)
(big-bang (make-text-state text (make-posn 50 50) "black")
[to-draw draw-state]
[on-mouse mouse-fn]
[on-key change-color]))
I'm designing a game for a class where:
A colored dot appears from the right side of the screen and moves across the screen to the left on a fixed horizontal axis.
When the dot reaches the middle, the player needs to press a key corresponding to its color. If done at the right time, the score increases by one.
If not, the player loses one life.
I'm having trouble with the following:
[SOLVED] Adding a new dot to the list of dots at random intervals in the game. This will make it so the dots don't appear linearly, and two dots can be generated right after one another.
[SOLVED] Moving the dots across the screen left to right.
[SOLVED] Removing the correct dot when it's in the hitbox area.
Removing a life if a dot goes offscreen.
The language used here is intermediate student with lambda.
Currently, when I press 1 for red, it will remove it as long as a red dot is the first in the list. I need a function that removes that specific red dot.
Here's the code so far; know that it's not finished and thus not working as I intend it to.
; Color Match
; Game structures
(define-struct dot [x color])
(define-struct cm [dots score lives state])
; Constants
(define width 800)
(define height (/ width (/ 16 9)))
(define h-w (/ width 2))
(define h-h (/ height 2))
(define arrow (beside (rectangle 25 10 "solid" "black")
(rotate 135 (right-triangle 18 18 "solid" "black"))))
(define background (empty-scene width height))
(define bars (place-images
(list
(circle (/ width 25) "outline" "black")
(rectangle (+ width 2) (- height 375) "outline" "black"))
(list
(make-posn h-w h-h)
(make-posn h-w h-h))
background))
; Game
(define (main ws)
(big-bang (make-cm empty 0 3 "start")
[on-tick tock]
[to-draw render]
[on-release interact]
))
;; random-color: number -> string
;; consumes a number and returns a color
;; string for the given number
(define (random-color n)
(cond
[(= n 0) "red"]
[(= n 1) "blue"]
[(= n 2) "green"]
[(= n 3) "yellow"]
[else (error "Invalid color chosen.")]))
;; draw-dot: structure -> image
;; consumes a dot structure and draws it as an image
(define (draw-dot struct)
(cond
[(string=? (dot-color struct) "red") (overlay
(rotate 90 arrow)
(circle (/ width 25) "outline" "black")
(circle (/ width 25) "solid" (dot-color struct)))]
[(string=? (dot-color struct) "blue") (overlay
(rotate 270 arrow)
(circle (/ width 25) "outline" "black")
(circle (/ width 25) "solid" (dot-color struct)))]
[(string=? (dot-color struct) "green") (overlay
(flip-horizontal arrow)
(circle (/ width 25) "outline" "black")
(circle (/ width 25) "solid" (dot-color struct)))]
[(string=? (dot-color struct) "yellow") (overlay
arrow
(circle (/ width 25) "outline" "black")
(circle (/ width 25) "solid" (dot-color struct)))]))
;; tock: color-match -> color-match
;; placeholder for later worldstate
(define (tock ws)
(cond
[(string=? (cm-state ws) "play")
(make-cm (move-dots (add-dot? (random 50) (cm-dots ws)))
(+ (cm-score ws) 1)
(cm-lives ws)
"play")]
[else ws]))
;; add-dot?: number, list of dots -> list of dots
;; consumes list of dots and number and adds a new dot
;; to the list of dots
(define (add-dot? n lod)
(cond
[(= n 1) (cons (make-dot (+ width 25) (random-color (random 4))) lod)]
[else lod]))
;; render: color-match -> image
;; consumes the current color-match structure and calls the appropriate
;; helper function.
(define (render ws)
(cond
[(string=? (cm-state ws) "start") (render-start ws)]
[(string=? (cm-state ws) "play") (render-play ws)]
[(string=? (cm-state ws) "pause") (render-pause ws)]
[else (error "Invalid gamestate chosen.")]))
;; render-start: color-match -> image
;; helps the render function by displaying the current state
;; as an image.
(define (render-start ws)
(place-image
(above
(text "Instructions" (/ width 20) "red")
(text "Colored shapes will begin appearing from the right of the screen." (/ width 50) "black")
(text "Once they reach the bar in the middle, press the appropriate key." (/ width 50) "black")
(text "1: Red" (/ width 50) "red")
(text "2: Blue" (/ width 50) "blue")
(text "3: Green" (/ width 50) "green")
(text "4: Yellow" (/ width 50) "yellow"))
h-w
h-h
background))
;; draw-dots: list of dots -> image
;; consumes a list of dots and draws them
;; according to their color
(define (draw-dots lod)
(cond
[(empty? lod) bars]
[else (place-image (draw-dot (first lod))
(dot-x (first lod))
h-h
(draw-dots (rest lod)))]))
;; is-visible?: dot -> boolean
;; consumes a dot and determines if it is currently visible
;; on the canvas
(define (is-visible? dot)
(cond
[(> (dot-x dot) -25) #true]
[else #false]))
;; move-dot: dot -> number
;; consumes a dot and returns its new
;; x coordinate
(define (move-dot dot)
(- (dot-x dot) 10))
;; new-dot: dot -> dot
;; consumes a dot and returns a new dot by calling
;; the move-dot function
(define (new-dot dot)
(make-dot (move-dot dot) (dot-color dot)))
;; move-dots: list of dots -> list of dots
;; consumes a list of dots and moves them across the
;; canvas as long as they are in view
(define (move-dots lod)
(cond
[(empty? lod) empty]
[(not (is-visible? (first lod))) (rest lod)]
[else (cons (new-dot (first lod)) (move-dots (rest lod)))]))
;; draw-bars: cm -> image
;; consumes the world state and returns the image of bars
(define (draw-bars ws)
(place-image (draw-dots (cm-dots ws))
h-w
h-h
bars))
;; render-play: color-match -> image
;; helps the render function by displaying the current state
;; as an image.
(define (render-play ws)
(overlay/align "left" "top" (current-lives ws)
(underlay/align "right" "top" (place-image (draw-bars ws)
h-w
h-h
background)
(current-score ws))))
;; current-lives: cm -> image
;; consumes the worldstate and displays the
;; current life count
(define (current-lives ws)
(text (string-append "Lives: " (number->string (cm-lives ws))) 18 "red"))
;; current-score: cm -> image
;; consumes the worldstate and shows the
;; current score
(define (current-score ws)
(text (string-append "Score: " (number->string (cm-score ws))) 18 "black"))
;; render-pause: color-match -> image
;; helps the render function by displaying the current state
;; as an image.
(define (render-pause ws)
(place-image
(text "paused" (/ width 20) "red")
h-w
(- h-h 75)
(render-play ws)))
; (define (check-dot lod key)
; (cond
; [(empty? lod) empty]
; [(and (< (- h-w (+ (/ width 25) 25)) (dot-x (first lod)) (+ h-w (+ (/ width 25) 25))) (string=? (dot-color (first lod)) "red") (key=? key "1")) (remove (make-dot (dot-x (first lod)) "red") lod)]
; [(and (< (- h-w (+ (/ width 25) 25)) (dot-x (first lod)) (+ h-w (+ (/ width 25) 25))) (string=? (dot-color (first lod)) "blue") (key=? key "2")) (remove (make-dot (dot-x (first lod)) "blue") lod)]
; [(and (< (- h-w (+ (/ width 25) 25)) (dot-x (first lod)) (+ h-w (+ (/ width 25) 25))) (string=? (dot-color (first lod)) "green") (key=? key "3")) (remove (make-dot (dot-x (first lod)) "green") lod)]
; [(and (< (- h-w (+ (/ width 25) 25)) (dot-x (first lod)) (+ h-w (+ (/ width 25) 25))) (string=? (dot-color (first lod)) "yellow") (key=? key "4")) (remove (make-dot (dot-x (first lod)) "yellow") lod)]
; [else lod]))
;; correct-dot? cm, lod, string -> list of dots
;; consumes the world state, its list of dots, a string, and sorts
;; out dots that have been correctly selected
(define (correct-dot? lod c)
(cond
[(empty? lod) empty]
[(and (< (- h-w (+ (/ width 25) 1)) (dot-x (first lod)) (+ h-w (+ (/ width 25) 1))) (string=? (dot-color (first lod)) c)) (correct-dot? (rest lod) c)]
[else (cons (first lod) (correct-dot? (rest lod) c))]))
;; is-it?: list of dots, key -> list of dots
;; consumes a list of dots and a key and returns
;; a new list of dots with one removed if the
;; conditions are met for it
(define (is-it? lod key)
(cond
[(empty? lod) empty]
[(key=? key "up") (correct-dot? lod "red")]
[(key=? key "down") (correct-dot? lod "blue")]
[(key=? key "left") (correct-dot? lod "green")]
[(key=? key "right") (correct-dot? lod "yellow")]
[else lod]))
;; interact: color-match, key -> color-match
;; consumes the current color-match state and returns
;; a new one depending on which key is pressed.
(define (interact ws key)
(cond
[(string=? (cm-state ws) "play")
(cond
[(key=? key "p") (make-cm (cm-dots ws)
(cm-score ws)
(cm-lives ws)
"pause")]
[else (make-cm (is-it? (cm-dots ws) key)
(cm-score ws)
(cm-lives ws)
(cm-state ws))])]
[(and (string=? (cm-state ws) "start") (key=? key "p")) (make-cm (cm-dots ws)
(cm-score ws)
(cm-lives ws)
"play")]
[(and (string=? (cm-state ws) "pause") (key=? key "p")) (make-cm (cm-dots ws)
(cm-score ws)
(cm-lives ws)
"play")]
[else ws]))
(main 200)
In ISL lists are not mutable so the only thing that you are able to do is create a new list with everything except what you want to remove. You could possibly filter through the list with your procedure only accepting the elements you want to keep
This code maintains number of ticks, but all ways paints on a new screen
#lang racket
(require 2htdp/universe)
(require 2htdp/image)
(define pasaulis (empty-scene 100 100))
(define (trace-circle t)
(place-image (circle 5 "solid" "blue")
(+ 50(* 40 (cos (/ t 100))))
(+ 50(* 40 (sin (/ t 100))))
pasaulis))
(define (render t)
(text (number->string t) 12 "red"))
(big-bang 1000000
(on-tick sub1 1/500)
(to-draw trace-circle)
(stop-when zero?)
(record? true))
The following code does maintain picture, but I could not have number of ticks passed to the pain handler.
#lang racket
(require 2htdp/universe)
(require 2htdp/image)
(require picturing-programs)
(define (move-right-10 picture)
(beside (rectangle 10 0 "solid" "white")
picture))
(big-bang pic:calendar
(on-draw show-it 500 100)
(on-tick move-right-10 1/22))
I just cannot figure it out. how to have draw function with number of ticks, while modifying the screen. Is the big-bang function suitable at all for the purpose?
Here is an example:
#lang racket
(require 2htdp/universe)
(require 2htdp/image)
(struct world (ticks pic))
(define pasaulis (empty-scene 1000 1000))
(define (render w)
(world-pic w))
(define (handle-on-tick w)
(define t (world-ticks w))
(define p (world-pic w))
(define new-ticks (+ t 1))
(define new-pic (overlay/xy (text (number->string t) 12 "red")
(* -10 t) (* -10 t)
p))
(world new-ticks new-pic))
(define (stop? w)
(= (world-ticks w) 50))
(big-bang (world 0 pasaulis)
(on-tick handle-on-tick 1/5)
(to-draw render)
(stop-when stop?))
I have my Emacs default new frame set to
(setq default-frame-alist
'((top . 150) (left . 400)
(width . 120) (height . 50)))
Is there a way to write a funciton to offset each new frame by 5 units at top and left so that each new frame will not be perfectly superimposed on top of each other? In other words, I want to cascade all new frames.
My system is OS X with Emacs 24.3.1
I suggest that you modify default-frame-alist in before-make-frame-hook:
(add-hook 'before-make-frame-hook 'cascade-default-frame-alist)
(defun cascade-default-frame-alist ()
(setq default-frame-alist
(mapcar (lambda (kv)
(if (memq (car kv) '(top left))
(cons (car kv) (+ 5 (cdr kv)))
kv))
default-frame-alist)))
If you want to modify default-frame-alist in-place, you need to create it with list instead of quote:
(setq default-frame-alist (list (cons 'top 150) (cons 'left 400)
(cons 'width 120) (cons 'height 50)))
(defun cascade-default-frame-alist ()
(dolist (kv default-frame-alist)
(when (memq (car kv) '(top left))
(setcdr kv (+ 5 (cdr kv))))))
I search how to transparent my emacs window. But it doesn't work.
Something like this failed:
(global-set-key [(f8)] 'loop-alpha)
(setq alpha-list '((100 100) (95 65) (85 55) (75 45) (65 35)))
(defun loop-alpha ()
(interactive)
(let ((h (car alpha-list)))
((lambda (a ab)
(set-frame-parameter (selected-frame) 'alpha (list a ab))
(add-to-list 'default-frame-alist (cons 'alpha (list a ab)))
) (car h) (car (cdr h)))
(setq alpha-list (cdr (append alpha-list (list h))))
)
)
Here's a working implementation of what I think you were trying to do:
(global-set-key [(f8)] 'loop-alpha)
(defvar alpha-list '((100 100) (95 65) (85 55) (75 45) (65 35)))
(defun next-alpha ()
(let ((current-alpha
(or (frame-parameter (selected-frame) 'alpha)
(first alpha-list)))
(lst alpha-list))
(or (second
(catch 'alpha
(while lst
(when (equal (first lst) current-alpha)
(throw 'alpha lst))
(setf lst (cdr lst)))))
(first alpha-list))))
(defun loop-alpha ()
(interactive)
(let ((new-alpha (next-alpha))
(current-default (assoc 'alpha default-frame-alist)))
(set-frame-parameter (selected-frame) 'alpha new-alpha)
(if current-default
(setcdr current-default new-alpha)
(add-to-list 'default-frame-alist (cons 'alpha new-alpha)))))
Notice that any version you write that redefines alpha-list is going to behave very strangely with multiple frames. I would explain what was wrong with your code, but I honestly couldn't work out what it was supposed to do. Note that this would be somewhat easier to write if I allowed myself to (require 'cl) first, but I think this code should work - it does here at any rate!