Merge pull request #1 from larstvei/nil

This commit is contained in:
Lars Tveito 2014-09-29 23:19:38 +02:00
commit 179f4f05c7
2 changed files with 112 additions and 1100 deletions

View File

@ -1,986 +0,0 @@
(defvar etype-word-vector
(apply 'vector (mapcar 'symbol-name
'(able
about
above
according
account
across
act
action
activities
activity
actually
added
addition
additional
administration
after
again
against
age
ago
ahead
aid
air
all
almost
alone
along
already
also
although
always
am
america
american
among
amount
an
analysis
and
another
answer
anti
any
anyone
anything
apparently
appear
appeared
approach
are
area
areas
arms
army
around
art
as
ask
asked
association
at
attack
attention
audience
available
average
away
back
bad
ball
based
basic
basis
be
beautiful
became
because
become
bed
been
before
began
beginning
behind
being
believe
below
best
better
between
beyond
big
bill
black
blood
blue
board
body
book
born
both
boy
boys
bring
british
brought
brown
building
built
business
but
by
call
called
came
can
cannot
cant
car
care
carried
cars
case
cases
cause
cent
center
central
century
certain
certainly
chance
change
changes
character
charge
chief
child
children
choice
christian
church
city
class
clear
clearly
close
closed
club
co
cold
college
color
come
comes
coming
committee
common
communist
community
company
complete
completely
concerned
conditions
congress
consider
considered
continued
control
corner
corps
cost
costs
could
couldnt
countries
country
county
couple
course
court
covered
cut
daily
dark
data
day
days
de
dead
deal
death
decided
decision
deep
defense
degree
democratic
department
described
design
designed
determined
developed
development
did
didnt
difference
different
difficult
direct
direction
directly
distance
district
do
does
doing
done
dont
door
doubt
down
dr
drive
due
during
each
earlier
early
earth
east
easy
economic
education
effect
effective
effects
effort
efforts
eight
either
elements
else
end
england
english
enough
entire
equipment
especially
established
europe
even
evening
ever
every
everything
evidence
example
except
existence
expect
expected
experience
extent
eye
eyes
face
fact
faith
fall
family
far
farm
father
fear
federal
feed
feel
feeling
feet
felt
few
field
figure
figures
filled
final
finally
find
fine
fire
firm
first
fiscal
five
floor
followed
following
food
foot
for
force
forces
foreign
form
former
forms
forward
found
four
free
freedom
french
friend
friends
from
front
full
function
further
future
game
gave
general
generally
george
get
getting
girl
girls
give
given
gives
glass
go
god
going
gone
good
got
government
great
greater
green
ground
group
groups
growing
growth
gun
had
hair
half
hall
hand
hands
happened
hard
has
have
having
he
head
hear
heard
heart
heavy
held
hell
help
her
here
herself
hes
high
higher
him
himself
his
history
hit
hold
home
hope
horse
hospital
hot
hotel
hour
hours
house
how
however
human
hundred
husband
idea
ideas
if
ill
im
image
immediately
important
in
include
including
income
increase
increased
indeed
individual
industrial
industry
influence
information
inside
instead
interest
international
into
involved
is
island
issue
it
its
itself
ive
job
john
just
justice
keep
kennedy
kept
kind
knew
know
knowledge
known
labor
lack
land
language
large
larger
last
late
later
latter
law
lay
lead
leaders
learned
least
leave
led
left
length
less
let
letter
letters
level
life
light
like
likely
line
lines
list
literature
little
live
lived
living
local
long
longer
look
looked
looking
lost
lot
love
low
lower
made
main
major
make
makes
making
man
manner
mans
many
march
market
married
mass
material
matter
may
maybe
me
mean
meaning
means
medical
meet
meeting
member
members
men
merely
met
method
methods
middle
might
miles
military
million
mind
minutes
miss
modern
moment
money
month
months
moral
more
morning
most
mother
move
moved
movement
moving
mr
mrs
much
music
must
my
myself
name
nation
national
nations
natural
nature
near
nearly
necessary
need
needed
needs
negro
neither
never
new
next
night
no
non
nor
normal
north
not
note
nothing
now
nuclear
number
numbers
obtained
obviously
of
off
office
often
oh
old
on
once
one
ones
only
open
opened
operation
opportunity
or
order
organization
other
others
our
out
outside
over
own
paid
paper
part
particular
particularly
parts
party
passed
past
pattern
pay
peace
people
per
performance
perhaps
period
person
personal
persons
physical
picture
piece
place
placed
plan
plane
planning
plans
plant
play
point
points
police
policy
political
pool
poor
population
position
possible
post
power
present
president
press
pressure
price
principle
private
probably
problem
problems
process
production
products
program
programs
progress
property
provide
provided
public
purpose
put
quality
question
questions
quite
race
radio
ran
range
rate
rather
reached
reaction
read
reading
ready
real
really
reason
received
recent
recently
record
red
religion
religious
remember
report
reported
required
research
respect
responsibility
rest
result
results
return
returned
right
river
road
room
run
running
said
sales
same
sat
saw
say
saying
says
school
schools
science
season
second
secretary
section
see
seem
seemed
seems
seen
self
sense
sent
series
serious
served
service
services
set
seven
several
shall
she
short
shot
should
show
showed
shown
side
similar
simple
simply
since
single
situation
six
size
slowly
small
so
social
society
some
something
sometimes
somewhat
son
soon
sort
sound
south
southern
soviet
space
speak
special
specific
spirit
spring
square
st
staff
stage
stand
standard
start
started
state
statements
states
stay
step
steps
still
stock
stood
stop
stopped
story
straight
street
strength
strong
student
students
study
subject
such
suddenly
summer
sun
support
sure
surface
system
systems
table
take
taken
taking
talk
tax
technical
tell
temperature
ten
term
terms
test
th
than
that
thats
the
their
them
themselves
then
theory
there
therefore
theres
these
they
thing
things
think
thinking
third
thirty
this
those
thought
three
through
through
throughout
thus
time
times
to
today
together
told
too
took
top
total
toward
town
trade
training
treatment
trial
tried
trouble
true
truth
try
trying
turn
turned
twenty
two
type
types
under
understand
understanding
union
united
university
until
up
upon
us
use
used
using
usually
value
values
various
very
view
voice
volume
waiting
walked
wall
want
wanted
war
was
washington
wasnt
water
way
ways
we
week
weeks
well
went
were
west
western
what
whatever
when
where
whether
which
while
white
who
whole
whom
whose
why
wide
wife
will
william
window
wish
with
within
without
woman
women
word
words
work
worked
working
works
world
would
wouldnt
writing
written
wrong
wrote
year
years
yes
yet
york
you
young
your
youre))))
(provide 'etype-lines)

226
etype.el
View File

@ -1,13 +1,18 @@
(require 'cl)
(require 'etype-lines)
(eval-when-compile
(require 'cl))
(defcustom etype-word-directory nil
"A path to a directory that contains a file 'etype.lines'. If
NIL a standard set of words will be used in the game.")
(defcustom etype-lines-file
(concat
(if load-file-name
(file-name-directory load-file-name)
default-directory) "etype.lines")
"A path to a file named 'etype.lines' containing one word per
line that will be used in the game."
:group 'etype)
(defvar etype-words-in-play nil)
(defvar etype-unused-words nil)
(defvar etype-unused-words [])
(defvar etype-score 0)
@ -23,19 +28,14 @@
(defvar etype-level 1)
(defconst etype-lines-file "etype.lines")
(defun etype-read-file ()
"Returns a vector of lines from the 'etype-lines-file'."
(if etype-word-directory
(with-temp-buffer
(insert-file-contents
(expand-file-name etype-lines-file etype-word-directory))
(apply
'vector
(split-string
(buffer-substring-no-properties (point-min) (point-max)) "\n")))
etype-word-vector))
(with-temp-buffer
(insert-file-contents etype-lines-file)
(apply
'vector
(split-string
(buffer-substring-no-properties (point-min) (point-max)) "\n"))))
(defun init-game ()
"Sets up the game grid containing 'fill-column' number of spaces and 30
@ -59,27 +59,24 @@ lines. Also some variables are set."
(setq etype-in-game t)
;; Shuffle the vector returned from etype-read-file, and turns it in to a
;; list.
(setq etype-unused-words
(mapcar 'eval (shuffle-vector (etype-read-file))))
(setq etype-unused-words (etype-read-file))
(read-only-mode 1))
(defun etype-increase-level ()
"Increases the level."
(interactive)
(when (< etype-level 10)
(setq inhibit-read-only t)
(incf etype-level)
(etype-update-level)
(setq inhibit-read-only nil)))
(let ((inhibit-read-only t))
(incf etype-level)
(etype-update-level))))
(defun etype-decrease-level ()
"Decreases the level."
(interactive)
(when (> etype-level 1)
(setq inhibit-read-only t)
(decf etype-level)
(etype-update-level)
(setq inhibit-read-only nil)))
(let ((inhibit-read-only t))
(decf etype-level)
(etype-update-level))))
(defun etype-fit-word (word)
"Returns a point that a word can be inserted on the next
@ -141,35 +138,34 @@ line."
"Move WORD at POINT to the next line. If there is not enough space on the
next line the word will not move."
(when etype-in-game
(setq inhibit-read-only t)
(when etype-completing-word
(goto-char etype-completing-word))
(let ((moving-word-at-point (string= word (current-word t)))
(search-string (buffer-substring-no-properties point (point))))
(save-excursion
(goto-char point)
(unless (looking-at word)
(goto-char (point-min))
(search-forward word etype-point-max)
(backward-word))
;; The point is now in front of the word that is to be moved.
(let ((point (point))
(timer (etype-search-timers word)))
(etype-next-line)
(let ((destination (etype-insert-word (point) word)))
(when destination
(etype-remove-word point word)
(setf (timer--args timer) (list destination word))))))
;; If we are moving the word at point the overlay must be moved and
;; the point needs to be updated.
(when moving-word-at-point
(search-forward-regexp (concat "\\<" search-string))
(setq etype-completing-word (point))
(let ((inhibit-read-only t))
(when etype-completing-word
(goto-char etype-completing-word))
(let ((moving-word-at-point (string= word (current-word t)))
(search-string (buffer-substring-no-properties point (point))))
(save-excursion
(let ((point (point)))
(backward-word)
(move-overlay etype-overlay (point) point)))))
(setq inhibit-read-only nil)))
(goto-char point)
(unless (looking-at word)
(goto-char (point-min))
(search-forward word etype-point-max)
(backward-word))
;; The point is now in front of the word that is to be moved.
(let ((point (point))
(timer (etype-search-timers word)))
(etype-next-line)
(let ((destination (etype-insert-word (point) word)))
(when destination
(etype-remove-word point word)
(setf (timer--args timer) (list destination word))))))
;; If we are moving the word at point the overlay must be moved and
;; the point needs to be updated.
(when moving-word-at-point
(search-forward-regexp (concat "\\<" search-string))
(setq etype-completing-word (point))
(save-excursion
(let ((point (point)))
(backward-word)
(move-overlay etype-overlay (point) point))))))))
(defun etype-random ()
"Returns a random float between 1 and 10, depending on the
@ -183,36 +179,40 @@ different capital letter from all words in
ETYPE-WORDS-IN-PLAY. It does not try very hard, and gives up
after checking 5 words - this is done to give a natural slow down
when there are a lot of words in play."
(let ((word (pop etype-unused-words)))
(let ((word (elt etype-unused-words
(random (length etype-unused-words)))))
(if (null (member
(string-to-char word)
(mapcar 'string-to-char etype-words-in-play)))
word
(add-to-list 'etype-unused-words word t)
(unless (and count (> count 5))
(etype-get-word (if count (+ count 1) 1))))))
(defun etype-spawn-word (&optional recur)
"This function spawns a word in the game. It does this by
finding a word and inserting it where it fits. It also updates
the timer which is associated with this function, setting it to a
new random time."
(defun etype-spawn-word ()
"This function spawns a word. It does this by finding a word
and inserting it at a random point in the game buffer. A timer
object is added to ETYPE-TIMERS, invoking ETYPE-MOVE-WORD at a
random time between 1 and 10 seconds."
(let* ((word (etype-get-word))
(point (1+ (random (- fill-column (1+ (length word))))))
(random (etype-random)))
(when (and word (etype-insert-word point word))
(push word etype-words-in-play)
(push (run-at-time random random 'etype-move-word (point) word)
etype-timers))))
(defun etype-spawn-wave (&optional recur)
"Spawn multiple words according to ETYPE-LEVEL."
(save-excursion
(when etype-in-game
(setq inhibit-read-only t)
(let* ((word (etype-get-word))
(point (random (- fill-column (length word))))
(random (etype-random)))
(when (and word (etype-insert-word point word))
(push word etype-words-in-play)
(push (run-at-time random random 'etype-move-word (point) word)
etype-timers)))
(when recur
(run-at-time (- 30 (* (etype-random) etype-level)) nil 'etype-spawn-word t)
(dotimes (i (+ (+ (random 10) etype-level)))
(run-at-time (- 30 (* (etype-random) etype-level))
nil 'etype-spawn-word)))
(setq inhibit-read-only nil))))
(let ((inhibit-read-only t))
(when (< recur (etype-wave-limit))
(etype-spawn-word)
(run-at-time (/ (etype-random) 5) nil
'etype-spawn-wave (1+ recur))))))
(defun etype-wave-limit ()
(+ (* etype-level etype-level) 5
(if (plusp etype-score) (ceiling (log etype-score)) 0)))
(defun etype-move-shooter (column)
"Moves the shooter to COLUMN."
@ -233,9 +233,10 @@ new random time."
(defun etype-shoot (&optional steps)
"Triggers the shooter to fire at a word. It calls itself
recursively until the bullet hits the word."
(setq inhibit-read-only t)
(unless (= 0 (current-column))
(let* ((bullet-dest (+ (- etype-point-max
(let* ((inhibit-read-only t)
(bullet-dest (+ (- etype-point-max
(* (or steps 0) (+ fill-column 1)))
(current-column)))
(overlay (make-overlay bullet-dest (+ bullet-dest 1)))
@ -244,8 +245,7 @@ recursively until the bullet hits the word."
(overlay-put overlay 'display "|")
(run-at-time (+ time 0.05) nil 'delete-overlay overlay)
(when (< (point) (- bullet-dest (+ fill-column 1)))
(run-at-time time nil 'etype-shoot (+ (or steps 0) 1)))))
(setq inhibit-read-only nil))
(run-at-time time nil 'etype-shoot (+ (or steps 0) 1))))))
(defun etype-search-word (key-etyped)
"Searches the buffer for a word that begins with the typed
@ -257,26 +257,25 @@ created."
"\\<" (single-key-description last-input-event))
etype-point-max t))
(when etype-completing-word
(setq inhibit-read-only t)
(etype-shoot)
(setq etype-overlay
(make-overlay (- etype-completing-word 1) etype-completing-word))
(overlay-put etype-overlay 'face '(:inherit isearch))
(setq inhibit-read-only nil)))
(let ((inhibit-read-only t))
(etype-shoot)
(setq etype-overlay
(make-overlay (- etype-completing-word 1) etype-completing-word))
(overlay-put etype-overlay 'face '(:inherit isearch)))))
(defun etype-continue-word (key-typed)
"Moves the point forward if the typed key is the char in front of the
point. If the word is complete the word is cleared."
(goto-char etype-completing-word)
(when (looking-at key-typed) (forward-char)
(setq etype-completing-word (point))
(setq inhibit-read-only t)
(move-overlay etype-overlay (overlay-start etype-overlay) (point))
(etype-shoot)
(when (looking-at " ")
(etype-clear-word)
(setq etype-completing-word nil))
(setq inhibit-read-only nil)))
(let ((inhibit-read-only t))
(when (looking-at key-typed)
(forward-char)
(setq etype-completing-word (point))
(move-overlay etype-overlay (overlay-start etype-overlay) (point))
(etype-shoot)
(when (looking-at " ")
(etype-clear-word)
(setq etype-completing-word nil)))))
(defun etype-update-score (word)
"Updates the score."
@ -292,9 +291,9 @@ point. If the word is complete the word is cleared."
(replace-match (concat "Level: " (number-to-string etype-level)))))
(defun etype-clear-word ()
"Removes a word from the game, and updating score."
(setq inhibit-read-only t)
(let* ((word (current-word t))
"Removes a word from the game, then updates the score."
(let* ((inhibit-read-only t)
(word (current-word t))
(timer (etype-search-timers (current-word t))))
(cancel-timer timer)
(setq etype-timers (remove timer etype-timers))
@ -304,10 +303,10 @@ point. If the word is complete the word is cleared."
(etype-remove-word (point) word)
(setq etype-words-in-play
(remove word etype-words-in-play))
(add-to-list 'etype-unused-words word t)
(etype-update-score word)
(goto-char (point-min)))
(setq inhibit-read-only nil))
(goto-char (point-min))
(unless etype-words-in-play
(etype-spawn-wave 0))))
(defun etype-catch-input ()
"'self-insert-command' is remapped to this function. Instead of
@ -324,9 +323,7 @@ inserting the typed key, it triggers a shot."
(switch-to-buffer "Etype")
(etype-mode)
(init-game)
(run-at-time 0 nil 'etype-spawn-word t)
(dotimes (i 10)
(run-at-time (random 10) nil 'etype-spawn-word)))
(run-at-time 0 nil 'etype-spawn-wave 0))
(defun etype-cleanup ()
"Cancels all etype-timers."
@ -334,15 +331,16 @@ inserting the typed key, it triggers a shot."
(define-derived-mode etype-mode nil "Etype"
"A mode for playing Etype."
(make-local-variable 'etype-score)
(make-local-variable 'etype-timers)
(make-local-variable 'etype-overlay)
(make-local-variable 'etype-in-game)
(make-local-variable 'etype-point-max)
(make-local-variable 'etype-unused-words)
(make-local-variable 'etype-words-in-play)
(make-local-variable 'etype-completing-word)
(make-local-variable 'etype-level)
(dolist (var '(etype-score
etype-timers
etype-overlay
etype-in-game
etype-point-max
etype-unused-words
etype-words-in-play
etype-completing-word
etype-level))
(make-local-variable var))
(define-key (current-local-map)
[remap self-insert-command] 'etype-catch-input)