# A tron-ish game.
# Author: Eduardo Ochs <eduardoochs.gmail>
# 2009nov18: I hereby place this file in the public domain -
# Use and modify as you wish. The old headers used to say:
#   Copyleft 2006, Eduardo Ochs <eduardoochs@gmail.com>.
#   First Icon version:       2006aug27.
#   This version:             2006aug27.
#   First Emacs Lisp version: 2004may31.
#
# Source:     <http://angg.twu.net/ICON/tron.icn>
# Htmlized:   <http://angg.twu.net/ICON/tron.icn.html>
# Screenshot: <http://angg.twu.net/ICON/tron.icn.png>
# See also:   <http://angg.twu.net/elisp/tron.el.html>
#             <http://angg.twu.net/elisp/tron.el.png>

# How to run it (or: "how I run it"):
#   (find-sh0 "cd ~/ICON/; icont -s tron.icn -x")
#   (eev      "cd ~/ICON/; icont -s tron.icn -x")
# On Debian, do this to install the dependencies:
#   apt-get install icont iconx icon-ipl
# What I use to htmlize this file:
#   (htmlize-file "~/ICON/tron.icn")
#   <http://www.emacswiki.org/emacs/Htmlize>
# About the sexp hyperlinks:
#   <http://angg.twu.net/emacs.html#what-is-eev>
#   <http://angg.twu.net/.emacs.html#iconbook>
#   (find-angg ".emacs" "iconbook")


# Rules: you're yellow and you leave a yellow trail when you walk.
# You never stop until you die. You die when you hit something
# yellow. Use the arrow keys to change your direction. Try to make
# the best score you can before you die. You only live once.
#
# In the beginning it's a black arena with yellow walls and a red
# square 3x3 "pixels" wide somewhere. Walking over a red "pixel"
# gives you one point and makes another 3x3 square appear somewhere.
# So, crossing a 3x3 red square from one side to another gives you
# three points and makes three other squares appear in random
# positions.
#
# Walking over black pixels is harmless.
#
# Sometimes the red squares will appear over your trail. Then some
# pixels of your trail will become red and you'll be able to cross.

# The game loop and the outer loop: typing "Q" or Esc or losing when
# you're playing makes you go to the outer loop; in the outer loop
# typing "P" or Enter or space restarts the game, and typing "Q" or
# Esc leaves the program.

# This is an implementation in Icon of a game that I wrote in
# 11 lines of IBM PC BASIC in the mid 80's. Here's the original code:
#
# 10 KEY OFF:SCREEN 1:COLOR 0,0:CLS:RANDOMIZE TIMER
# 20 LINE (0,0)-(319,192),,b:X=150:Y=90:DX=1:DY=0:PTS=0
# 30 GOSUB 110:GOSUB 100
# 40 C=POINT(X,Y):IF C=3 THEN 90 ELSE PSET(X,Y),3
# 50 IF C=2 THEN PTS=PTS+1:GOSUB 100:GOSUB 110:SOUND 200,,2
# 60 A$=INKEY$:IF A$="" THEN 80 ELSE ND=INSTR("WASZwasz",A$)-1:IF ND<0 GOTO 80
# 70 MM=(ND AND 2)-1:H=ND AND 1:IF (H=1)<>(DX<>0) THEN DX=H*MM:DY=(1-H)*MM
# 80 X=X+DX:Y=Y+DY:GOTO 40
# 90 END
# 100 LOCATE 25,1:PRINT "Score:";PTS;:LOCATE 1,1:RETURN
# 110 H=RND*316+1:V=RND*188+1:LINE(H,V)-(H+2,V+2),2,BF:RETURN

# Before this Icon version I wrote a version in Emacs Lisp, at:
#   (find-angg "elisp/tron.el")
# The htmlized ".el" file it has a link to a screenshot somewhere.
#   (find-anggfile "elisp/tron.el.png")
# This version lacks important features - for example sound and
# choosing the size - the "pixels" are always 2x2 now, but 3x3
# would fit better in 1024x768 screens.

# (find-iplfile "graphics.icn")
# (find-iplfile "window.icn")
link graphics

# (find-iconbookpage (+ 22  98) "global identifier-list")
# (find-iconbooktext            "global identifier-list")
# (find-iconbookpage (+ 22  81) "table(x)")
# (find-iconbooktext            "table(x)")
# (find-iconbookpage (+ 22  73) "powers := [i, i ^ 2, i ^ 3, i ^ 4]")
# (find-iconbooktext            "powers := [i, i ^ 2, i ^ 3, i ^ 4]")
# (find-iconbookpage (+ 22  21) "expr1 | expr2")
# (find-iconbooktext            "expr1 | expr2")
# (find-iconbookpage (+ 22  20) "The do clause is optional")
# (find-iconbooktext            "The do clause is optional")
# (find-iconbookpage (+ 22  66) "?i produces a pseudo-random")
# (find-iconbooktext            "?i produces a pseudo-random")
# (find-iconbookpage (+ 22 378) "Event(), 155-156")
# (find-iconbooktext            "Event(), 155-156")
# (find-iplfile "keysyms.icn" "$define Key_Down")

# (find-iconbookpage (+ 22 144) "WOpen")
# (find-iconbooktext            "WOpen")
# (find-iconbookpage (+ 22 146) "DrawRectangle(x, y, w, h)")
# (find-iconbooktext            "DrawRectangle(x, y, w, h)")
# (find-iconbookpage (+ 22 150) "font=Helvetica,12,bold")
# (find-iconbooktext            "font=Helvetica,12,bold")
# (find-iconbookpage (+ 22 176) "link graphics")
# (find-iconbooktext            "link graphics")
# (find-iconbookpage (+ 22  31) "without an explicit return")
# (find-iconbooktext            "without an explicit return")
# (find-iconbookpage (+ 22 298) "\nINFIX OPERATIONS")
# (find-iconbooktext            "\nINFIX OPERATIONS")
# (find-icongrbookpage (+ 24 127) "WWrite")
# (find-icongrbookpage (+ 24 192) "audible")
# (find-icongrbookpage (+ 24 495) "Index")
# (find-icongrbookpage (+ 24 192) "WDelay() also flushes")
# (find-icongrbookpage (+ 24 407) "WDelay() flushes any pending output")

$include "keysyms.icn"
global actions, direction
global x, y, dx, dy
global score
global pixels

procedure prepare_vars()
  actions := table()
  actions[Key_Down]  := ["v", +1]
  actions[Key_Up]    := ["v", -1]
  actions[Key_Right] := ["h", +1]
  actions[Key_Left]  := ["h", -1]
  every actions["q" | "Q" | "\e"] := "quit"
  set_direction(["h", +1])
  x := 150
  y := 90
  score := 0
  pixels := table()
  every pixels[0 to 199] := table(0)
end

procedure set_color(n)
  if n == 0 then WAttrib("fg=black")
  if n == 1 then WAttrib("fg=red")
  if n == 3 then WAttrib("fg=brown")
end

procedure pset(x, y, color)
  set_color(color)
  pixels[y][x] := color
  FillRectangle(x*2, y*2, 2, 2)
end

procedure point(x, y)
  return pixels[y][x]
end

procedure draw_red_square()
  local x, y
  x := ?316
  y := ?188
  every pset(x to x+2, y to y+2, 1)
end

procedure is_direction(action)
  return type(action) == "list"
end

procedure ignored_turn(newdirection)
  return newdirection[1] == direction[1]
end

procedure set_direction(newdirection)
  direction := newdirection
  if direction[1] == "h" then {
    dx := direction[2]; dy := 0
  } else {
    dy := direction[2]; dx := 0
  }
end

procedure process_events()
  while *Pending() > 0 do {
    e := Event()
    # w(e)
    action := actions[e]
    if is_direction(action) then {
      if not ignored_turn(action) then {
        set_direction(action)
        return
      }
    }
    if action === "quit" then
      fail
  }
  return
end

procedure prepare_walls()
  every pset(0 to 319,   0, 3)
  every pset(0 to 319, 191, 3)
  every pset(0,   0 to 191, 3)
  every pset(319, 0 to 191, 3)
end

procedure draw_score()
  GotoXY(6, 396)
  set_color(3)
  WWrites("Score: " || score)
end

procedure play()
  prepare_vars()
  set_color(0)
  FillRectangle(0, 0, 640, 400)
  prepare_walls()
  pset(x, y, 3)
  draw_red_square()
  draw_score()

  WDelay(1000)

  while process_events() do {
    x +:= dx
    y +:= dy
    if point(x, y) == 3 then break
    if point(x, y) == 1 then {
      draw_red_square(); score +:= 1; draw_score()
      pset(x, y, 3)
      WDelay(50)
    }
    pset(x, y, 3)
    WDelay(50)
  }
end

procedure main(args)
  # w(actions)
  WOpen("size=640,400", "fg=yellow", "bg=black")
  WAttrib("font=Helvetica,12,bold")

  while 1 do {
    play()
    while e := Event() do {
      if e === ("q" | "Q" | "\e") then return
      if e === ("p" | "P" | " " | "\r" | "\n") then break
    }
  }
end