-

   rss_rss_hh_new

 - e-mail

 

 -

 LiveInternet.ru:
: 17.03.2011
:
:
: 51

:


Scheme(Lisp) DrRacket

, 18 2017 . 18:47 +
DrRacket.
.
.
, .
.
.
.
image

, , .
#lang racket
(require picturing-programs)
(define (DOT s)  (circle 100 "solid" s))

s , .

(define (traffic-light-next s)
  (cond
    [(string=? "red" s) "green"]
    [(string=? "green" s) "yellow"]
    [(string=? "yellow" s) "red"]))

, , big-bang.
(big-bang "red"
          [on-tick traffic-light-next 1]
          [to-draw DOT])   
    

1 .
, , ..
,
, .. ,
. () .
 [(> (+ x DELTA) WIDTH)  0]

, .
(cond
      [(> (+ x dx) WIDTH)  0]
       [else (+ x dx)]        )

DELTA x

#lang racket
(require 2htdp/image)
(require 2htdp/universe)
(define WIDTH 100)
(define DELTA 1)
(define BALL (circle 5 "solid" "red"))
(define MT   (empty-scene WIDTH 10))
 (define (main x0)
  (big-bang x0
    [to-draw render]
    [on-tick bounce]))
(define (bounce x)
      (cond
      [(> (+ x DELTA) WIDTH)  0]
       [else (+ x DELTA)]  ))
 (define (render x)
  (place-image BALL   x 5 MT))
(main 50)

, big-bang. , .
,
left right.
.
#lang racket
(require 2htdp/image)
(require 2htdp/universe)
(define BACKGROUND (empty-scene 100 100))
(define DOT (circle 10 "solid" "red"))
(define (place-dot-at x)
  (place-image DOT x 50 BACKGROUND))
(define (change-func p k) ;  
  (cond
    [(string=? "left" k)
     (- p 5)]
    [(string=? "right" k)
     (+ p 5)]
    [else p]))
( big-bang 50
[to-draw place-dot-at] 
[on-key change-func]   )

up, down,

(define-struct posn (x y))
(define INIT-WORLD (make-posn 100 100))

, .
#lang racket
(require picturing-programs) 
(define WIDTH 200)
(define HEIGHT 200)
(define BACKGROUND     (empty-scene WIDTH HEIGHT))
(define obj1 (circle 10 "solid" "red"))
(define-struct posn (x y))            ; 
(define INIT-WORLD (make-posn 100 100) )
(define (change-current-world-key current-world a-key-event) ; ""  
  (cond
    [(key=? a-key-event "up")
     (make-posn (posn-x current-world) (- (posn-y current-world) 5))]
    [(key=? a-key-event "down")
    (make-posn (posn-x current-world) (+ (posn-y current-world) 5))]
    [(key=? a-key-event "left")
     (make-posn (-(posn-x current-world)5) (posn-y current-world) )]
    [(key=? a-key-event "right")
    (make-posn (+(posn-x current-world)5) (posn-y current-world) )]
    [else current-world]))
(define (redraw current-world)
  (place-image obj1
               (posn-x current-world)
               (posn-y current-world)
               BACKGROUND))
(big-bang INIT-WORLD
(on-key change-current-world-key)
(on-draw redraw) )

, .
, .
: world posn.
#lang racket
(require picturing-programs) 
(define WIDTH 300)
(define HEIGHT 300)
(define BACKGROUND     (empty-scene WIDTH HEIGHT))
(define obj1 (circle 10 "solid" "red"))
(define obj2 (circle 10 "solid" "green"))
(define-struct posn (x y))
(define-struct world [obj1 obj2])
;     world
(define INIT-WORLD (make-world (make-posn 100 100) (make-posn 200 100)))
(define (draw-game world)
   (place-image 
      obj1
      (posn-x (world-obj1 world))
      (posn-y (world-obj1 world))
      (place-image 
         obj2
         (posn-x (world-obj2 world))
         (posn-y (world-obj2 world))
         BACKGROUND)))
(big-bang   INIT-WORLD
  [to-draw draw-game])

, , .
#lang racket
(require picturing-programs) 
(define WIDTH 300)
(define HEIGHT 300)
(define BACKGROUND (empty-scene WIDTH HEIGHT))
(define obj1 (circle 10 "solid" "red"))
(define obj2 (circle 10 "solid" "green"))
(define-struct posn (x y))
(define-struct world [obj1 obj2])
(define INIT-WORLD (make-world (make-posn 50 150) (make-posn 250 150)))
(define (change-current-world-key current-world a-key-event)
  (make-world (change-obj1 (world-obj1 current-world) a-key-event)
              (world-obj2 current-world)))
(define (change-obj1 a-posn a-key-event)
  (cond
    [(key=? a-key-event "up")
     (make-posn (posn-x a-posn) (- (posn-y a-posn) 5))]
    [(key=? a-key-event "down")
     (make-posn (posn-x a-posn) (+ (posn-y a-posn) 5))]
    [(key=? a-key-event "left")
     (make-posn (-(posn-x a-posn) 5) (posn-y a-posn) )]
    [(key=? a-key-event "right")
     (make-posn (+(posn-x a-posn)5) (posn-y a-posn) )]
    [else a-posn]))
(define (draw-game world)
   (place-image 
      obj1
      (posn-x (world-obj1 world))
      (posn-y (world-obj1 world))
     (place-image 
        obj2
        (posn-x (world-obj2 world))
        (posn-y (world-obj2 world))
         BACKGROUND)))
(big-bang   INIT-WORLD
(on-key change-current-world-key)
  [to-draw draw-game] )


How to Design Worlds.
Original source: habrahabr.ru (comments, light).

https://habrahabr.ru/post/328924/

:  

: [1] []
 

:
: 

: ( )

:

  URL