Advertisement
nicolas42

Snake

Oct 26th, 2012
1,062
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. rebol [title: "Snake"]
  2.  
  3. snake-game-object: context [
  4.  
  5.     readme: {
  6.         Snake
  7.         original code by Nick Antonaccio at re-bol.com
  8.         written in rebol rebol.com
  9.     }
  10.  
  11.     snake: to-image layout/tight [box red 10x10 edge none]
  12.     food: to-image layout/tight [box green 10x10 edge none] ;[1]
  13.  
  14.     the-score: 0  direction: 0x10  newsection: false  random/seed now
  15.  
  16.     dq: [0x10] ;direction queue; future directions ;[2]
  17.  
  18.     rand-pair: func [s] [
  19.         to-pair rejoin [(round/to random s 10) "x" (round/to random s 10)]
  20.     ]
  21.  
  22.     ;b is the image that is drawn in the rebol draw dialect
  23.     ;its structure is 'image <actual image> position 'image <actual image> position ...
  24.     ;b/3 is apple position. b/6 is snake head position
  25.     b: reduce [
  26.         'image food ((rand-pair 190) + 50x50)
  27.         'image snake 150x150
  28.         'image snake 150x160 ;[5]
  29.     ]
  30.  
  31.     view/new win: layout [
  32.         scrn: box white 300x300 effect [draw b] rate 20
  33.         origin across h2 "Score:"
  34.         score: h2 bold "000000"
  35.         do [focus scrn]
  36.     ]
  37.  
  38.     scrn/feel/engage: func [f a e] [
  39.  
  40.         if a = 'key [
  41.        
  42.             ;dq direction queue, d direction
  43.             unless find [up down left right] e/key [exit]
  44.             d: select [up 0x-10 down 0x10 left -10x0 right 10x0] e/key
  45.             if not equal? last dq negate d [append dq d] ;[3] prevents turning directly backwards
  46.  
  47.         ]
  48.        
  49.         if a = 'time [
  50.        
  51.             direction: either 1 = length? dq [first dq] [take dq] ;[4]
  52.        
  53.             ;If snake hits self or wall
  54.             if any [b/6/1 < 0 b/6/2 < 0 b/6/1 > 290 b/6/2 > 290] [
  55.                 alert "You hit the wall!" unview/only win
  56.             ]
  57.             if find (at b 7) b/6 [alert "You hit yourself!" unview/only win]
  58.            
  59.             ;If an apple is eaten
  60.             if within? b/6 b/3 10x10 [
  61.                 append b reduce ['image snake (last b)]
  62.                 newsection: true
  63.                 b/3: (rand-pair 290)
  64.                
  65.                 the-score: the-score + 1
  66.                 score/text: to-string the-score
  67.             ]
  68.            
  69.             ;create new image b
  70.             newb: copy/part head b 5  append newb (b/6 + direction)
  71.             for item 7 (length? head b) 1 [
  72.                 either (type? (pick b item) = pair!) [
  73.                     append newb pick b (item - 3)
  74.                 ] [
  75.                     append newb pick b item
  76.                 ]
  77.             ]
  78.            
  79.             if newsection = true [
  80.                 clear (back tail newb)
  81.                 append newb (last b)
  82.                 newsection: false
  83.             ]
  84.            
  85.             ;show new image
  86.             b: copy newb
  87.             show scrn
  88.            
  89.         ]
  90.     ]
  91.  
  92.     scrn/text: None ;[6]
  93.  
  94.     ;set global
  95.     set 'snake-game scrn
  96.     do-events
  97.  
  98.     doc: {
  99.     Alterations
  100.     added direction queue to replace single direction variable.
  101.     This means all key events are actioned whereas
  102.     beforehand if two key events were close together only the second one would be actioned.
  103.  
  104.     Also changed code so snake cannot backtrack on itself.
  105.  
  106.     Minor alterations - score changed when apple is eaten.
  107.     Set scrn/text to none to remove white cursor artifact
  108.     added comments
  109.     changed images to green and red boxes
  110.  
  111.     Possible evolutions
  112.     enable replay
  113.     replace alert code. Just replace replace the draw code with something.
  114.  
  115.     }
  116.  
  117. ]
Advertisement
RAW Paste Data Copied
Advertisement