home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / progs / snake.icn < prev    next >
Text File  |  2002-03-26  |  6KB  |  249 lines
  1. ############################################################################
  2. #
  3. #    File:     snake.icn
  4. #
  5. #    Subject:  Program to play the snake game
  6. #
  7. #    Author:   Richard L. Goerwitz
  8. #
  9. #    Date:     March 26, 2002
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #    Version:  1.9
  18. #
  19. ############################################################################
  20. #  
  21. #      While away the idle moments watching the snake eat blank squares
  22. #  on your screen.  Snake has only one (optional) argument -
  23. #
  24. #      usage:  snake [character]
  25. #
  26. #  where "character" represents a single character to be used in drawing
  27. #  the snake.  The default is an "o."  In order to run snake, your ter-
  28. #  minal must have cursor movement capability, and must be able to do re-
  29. #  verse video.
  30. #
  31. #      I wrote this program to test itlib.icn, iscreen.icn, and some
  32. #  miscellaneous utilities I wrote.  It clears the screen, moves the cur-
  33. #  sor to arbitrary squares on the screen, changes video mode, and in
  34. #  general exercises the terminal capability database on the target ma-
  35. #  chine.
  36. #
  37. ############################################################################
  38. #
  39. #  Bugs:  Most magic cookie terminals just won't work.  Terminal really
  40. #  needs reverse video (it will work without, but won't look as cute).
  41. #
  42. ############################################################################
  43. #
  44. #  Requires:  UNIX (MS-DOS is okay, if you replace itlib with itlibdos.icn)
  45. #
  46. ############################################################################
  47. #
  48. #  Links: itlib, iscreen, random
  49. #
  50. ############################################################################
  51.  
  52. link itlib
  53. link iscreen
  54. link random
  55.  
  56. global max_l, max_w, snake_char
  57.  
  58. record wholething(poop,body)
  59.  
  60. procedure main(a)
  61.  
  62.     local snake, limit, sl, sw, CM, x, r, leftbehind
  63.  
  64.     randomize()
  65.  
  66.     if not (getval("so"),  CM := getval("cm"))
  67.     then stop("snake:  Your terminal is too stupid to run me.  Sorry.")
  68.     clear(); Kludge() # if your term likes it, use emphasize(); clear()
  69.     # Decide how much space we have to operate in.
  70.     max_l := getval("li")-2             # global
  71.     max_w := getval("co")-1             # global
  72.     # Determine the character that will be used to represent the snake.
  73.     snake_char := (\a[1])[1] | "o"
  74.  
  75.     # Make the head.
  76.     snake := []; put(snake,[?(max_l-1)+1, ?(max_w-1)+1])
  77.     # Make the body, displaying it as it grows.
  78.     every x := 2 to 25 do {
  79.     display(,snake)
  80.     put(snake,findnext(snake[x-1],snake))
  81.     }
  82.  
  83.     # Begin "eating" all the standout mode spaces on the screen.
  84.     repeat {
  85.     r := makenew(snake)
  86.     leftbehind := r.poop
  87.     snake := r.body
  88.     display(leftbehind,snake) | break
  89.     }
  90.  
  91.     # Shrink the snake down to nothing, displaying successively smaller bits.
  92.     while leftbehind := get(snake)
  93.     do display(leftbehind,snake)
  94.  
  95.     iputs(igoto(getval("cm"), 1, getval("li")-1))
  96.     normal()
  97.     
  98. end 
  99.  
  100.  
  101.  
  102. procedure findnext(L, snake)
  103.  
  104.     local i, j, k, op, l
  105.     static sub_lists
  106.     initial {
  107.     sub_lists := [[1,2,3], [1,3,2], [3,2,1], [3,1,2], [2,1,3], [2,3,1]]
  108.     }
  109.     # global max_l, max_w
  110.  
  111.     i := L[1]; j := L[2]    # for clarity, use i, j (not l[i|j])
  112.  
  113.     # L is the last snake segment; find k and l, such that k and l are
  114.     # valid line and column numbers differing from l[1] and l[2] by no
  115.     # more than 1, respectively.  Put simply:  Create a new segment
  116.     # [k, l] adjacent to the last one (L).
  117.  
  118.     op := (different | Null) &
  119.     (k := max_l+1 > [i,i+1,i-1][!sub_lists[?6]]) > 1 &
  120.     (l := max_w+1 > [j,j+1,j-1][!sub_lists[?6]]) > 1 &
  121.     op([k, l], snake)
  122.  
  123.     return [k, l]
  124.  
  125. end
  126.  
  127.  
  128.  
  129. procedure different(l,snake)
  130.  
  131.     local bit
  132.     (l[1] = (bit := !\snake)[1], l[2] = bit[2]) & fail
  133.     return
  134.  
  135. end
  136.  
  137.  
  138.  
  139. procedure Null(a[])
  140.     return
  141. end
  142.  
  143.  
  144.  
  145. procedure display(lb,snake)
  146.  
  147.     local last_segment, character
  148.     static CM
  149.     initial CM := getval("cm")
  150.  
  151.     # Change the mode of the square just "vacated" by the moving snake.
  152.     if *snake = 0 | different(\lb,snake) then {
  153.     iputs(igoto(CM, lb[2], lb[1]))
  154.     normal()
  155.     writes(" ")
  156.     }
  157.  
  158.     if last_segment := (0 ~= *snake) then {
  159.     # Write the last segment (which turns out to be the snakes head!).
  160.     iputs(igoto(CM, snake[last_segment][2], snake[last_segment][1]))
  161.     emphasize(); writes(snake_char)  # snake_char is global
  162.     }
  163.  
  164.     # Check to see whether we've eaten every edible square on the screen.
  165.     if done_yet(lb)
  166.     then fail
  167.     else return
  168.  
  169. end
  170.  
  171.  
  172.  
  173. procedure makenew(snake)
  174.     local leftbehind, i
  175.  
  176.     # Move each constituent list up one position in snake, discard
  177.     # the first element, and tack a new one onto the end.
  178.  
  179.     every i := 1 to *snake - 1 do
  180.     snake[i] :=: snake[i+1]
  181.     leftbehind := copy(snake[i+1])
  182.     snake[i+1] := findnext(snake[i],snake)
  183.     return wholething(leftbehind,snake)
  184.     
  185. end
  186.  
  187.  
  188.  
  189. procedure the_same(l1, l2)
  190.  
  191.     if l1[1] = l2[1] & l1[2] = l2[2]
  192.     then return else fail
  193.  
  194. end
  195.  
  196.  
  197.  
  198. procedure done_yet(l)
  199.     local i, j
  200.  
  201.     # Check to see if we've eaten every edible square on the screen.
  202.     # It's easy for snake to screw up on this one, since somewhere
  203.     # along the line most terminal/driver/line combinations will con-
  204.     # spire to drop a character somewhere along the line.
  205.  
  206.     static square_set
  207.     initial {
  208.  
  209.     square_set := set()
  210.     every i := 2 to max_l do {
  211.         every j := 2 to max_w do {
  212.         insert(square_set, i*j)
  213.         }
  214.     }
  215.     }
  216.  
  217.     /l & fail
  218.     delete(square_set, l[1]*l[2])
  219.     if *square_set = 0 then return
  220.     else fail
  221.  
  222. end
  223.  
  224.  
  225.  
  226. procedure Kludge()
  227.     local i
  228.  
  229.     # Horrible way of clearing the screen to all reverse-video, but
  230.     # the only apparent way we can do it "portably" using the termcap
  231.     # capability database.
  232.  
  233.     iputs(igoto(getval("cm"),1,1))
  234.     if getval("am") then {
  235.     emphasize()
  236.         every 1 to (getval("li")-1) * getval("co") do
  237.         writes(" ")
  238.     }
  239.     else {
  240.     every i := 1 to getval("li")-1 do {
  241.         iputs(igoto(getval("cm"), 1, i))
  242.         emphasize()
  243.         writes(repl(" ",getval("co")))
  244.     }
  245.     }
  246.     iputs(igoto(getval("cm"),1,1))
  247.  
  248. end
  249.