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