
; letterfall/numberfall.sscm - main driver for Letterfall 2: Numberfall
; Copyright (C) 2012 Alan Manuel K. Gloria
;
; This file is part of Letterfall.
;
; This program is free software; you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; This program is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY, without even the implied warranty of
; MERCHANTIBILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
;
; You should have received a copy of the GNU General Public License
; along with this program.  If not, see <http://www.gnu.org/licenses/>

define-module
  letterfall numberfall
  :export
  \\
    main

use-modules
  letterfall kont
  letterfall kgtk
  ;
  srfi srfi-9

define main(_)
  ; initialize random number
  set! *random-state* $ seed->random-state $ car $ gettimeofday()
  execute-kmonad kmain
    lambda ___
      exit 0

define esc-key $ integer->char 27
define backspace-key $ integer->char 8
define center(line str) $ kdo
  let len \\ lift $ string-length str
  let col \\ lift $ { 20 - inexact->exact(floor{ len / 2 })}
  gotoxy col line
  print str

define kmain $ kdo
  kgtk-start "Letterfall 2: Numberfall"
  kmain-loop
define kmain-loop $ kdo
  lift '()
  let opt \\ title-screen
  if { opt eq? 'help-option }
    help-screen
    play-game
  kmain-loop

define title-screen $ kdo
  center 8 "LETTERFALL 2: NUMBERFALL"
  center 14 "TYPE 'PLAY' TO START"
  center 16 "TYPE 'HELP' FOR INSTRUCTIONS"
  refresh-screen
  wait-for-play-or-help
define wait-for-play-or-help $ kdo
  lift '()
  let k-raw \\ get-key
  let k \\ lift $ char-toupper k-raw
  cond
    { k char=? #\P } $ kdo
      gotoxy 17 18
      print k
      refresh-screen
      wait-for-typein 0 #(#\L #\A #\Y) 'play-option
    { k char=? #\H } $ kdo
      gotoxy 17 18
      print k
      refresh-screen
      wait-for-typein 0 #(#\E #\L #\P) 'help-option
    else             $ wait-for-play-or-help
define wait-for-typein(i arr ret-val) $ cond
  { i = vector-length(arr)} $ lift ret-val
  else                      $ kdo
    let c \\ lift $ vector-ref arr i
    let k \\ get-key
    cond
      { k char=? backspace-key } $ kdo
      ! gotoxy { 17 + i} 18
      ! print " "
      ! refresh-screen
      ! if { i = 0 }
      !   wait-for-play-or-help
      !   wait-for-typein { i - 1 } arr ret-val
      { char-toupper(k) char=? c } $ kdo
      ! gotoxy { 18 + i } 18
      ! print c
      ! refresh-screen
      ! wait-for-typein { i + 1 } arr ret-val
      else
      ! wait-for-typein i arr ret-val

define help-screen $ kdo
  lift '()
  cls
  center 0  "LETTERFALL 2: NUMBERFALL"
  center 1  "------------------------"
  ;          |--------------------------------------|
  center 3  "IN THE PREVIOUS EPISODE YOU CONQUERED"
  center 4  "THE LETTERS.  THEY HAVE JOINED OUR"
  center 5  "NOBLE CAUSE UNDER THE CONTROL OF YOUR"
  center 6  "ALL POWERFUL TOOL: THE KEYBOARD!"
  ;
  center 8  "BUT THE NUMBERS HAVE DECLARED WAR!"
  ;
  center 10 "USE YOUR KEYBOARD TO COMMAND YOUR"
  center 11 "LETTER MINIONS TO ATTACK INVADING"
  center 12 "NUMBERS.  TAP NUMBER KEYS TO ORDER"
  center 13 "DIRECT HITS FROM YOUR TWO SNIPERS ON"
  center 14 "SPECIFIC INVADING NUMBERS."
  ;          |--------------------------------------|
  center 16 "ALLOCATE YOUR RESOURCES CAREFULLY:"
  center 17 "LETTERS TAKE TIME TO RELOAD.  AND YOUR"
  center 18 "TWO SNIPERS TAKE EVEN LONGER TO RELOAD."
  ;
  center 20 "IF A NUMBER LANDS IT WILL DESTROY THE"
  center 21 "LETTER THERE PERMANENTLY.  IF IT LANDS"
  center 22 "ON A DESTROYED LETTER: YOU LOSE!"
  ;
  center 24 "GOOD LUCK TYPIST!"
  refresh-screen
  get-key
  cls

define play-game $ kdo
  lift '()
  let state \\ lift initial-state()
  complete-render state
  game-loop state

define-record-type <game-state>
  game-state pressure letters sniper1 sniper2 numbers
  game-state?
  pressure pressure-state set-pressure-state!
  letters  letters-state
  sniper1  sniper1-state  set-sniper1-state!
  sniper2  sniper2-state  set-sniper2-state!
  numbers  numbers-state
define-record-type <falling-number>
  falling-number speed time number
  falling-number?
  speed  speed-number
  time   time-number   set-time-number!
  number actual-number

; state slots meaning:
; pressure - a steadily-rising number (the score)
;   which indicates how difficult to make the game
;   for the player, or #f if the game is over.
; letters - a 26-item vector.  Item 0 = A and so on.
;   Contains the row number that the letter is
;   currently in, or a negative number while
;   reloading, or #f if letter has been destroyed.
; sniper1, sniper2 - either #f (ready) or a number
;   while reloading.
; numbers - a 26 x 24 vector.  Each vector item is
;   either #f (meaning nothing at that location),
;   or a <falling-number>.
;
; falling-number slots meaning:
; speed - how many clock ticks this number takes to
;   fall to the next level.
; time - how many more clock ticks remaining before
;   this number goes to the next level.
; number - the actual number

define numbers-size { 26 * 24 }
define initial-state()
  game-state
    ; pressure
      0
    ; letters
      make-vector 26 '24
    ; sniper1
      #f
    ; sniper2
      #f
    ; numbers
      make-vector numbers-size '#f

define game-loop(st) $ kdo
  lift '()
  wait 25 ; fixed clock ticks
  ;
  ; get the key
  let k-raw \\ try-get-key
  let k \\ lift $ and k-raw
                      char-toupper k-raw
  ; extract items
  let current-pressure \\ lift $ pressure-state st
  let letters \\ lift $ letters-state st
  let numbers \\ lift $ numbers-state st
  ;
  ; handle letters
  for-i-k 26 $ lambda (i)
    let
      \\
        letter $ vector-ref letters i
        char   $ integer->char { 65 + i }
      cond
        ; letter is dead?
        not(letter) $ kdo
        ! ; nothing to do
        ! lift '()
        ;
        ; letter is ready for firing?
        { letter = 24 } $ kdo
        ! if { k and { k char=? char }}
        !   kdo
        !     lift $ begin
        !       vector-set! letters i 23
        !       '()
        !     gotoxy { 7 + i } 24
        !     print " "
        !     gotoxy { 7 + i } 23
        !     print char
        !   lift '()
        ;
        ; letter is shooting upwards?
        { letter >= 0 } $ kdo
        ! gotoxy { 7 + i } letter
        ! print " "
        ! let random-time-limit \\ lift $ max 1 $ inexact->exact $ floor {{ pressure-state(st) / 4 } + 1 }
        ! let random-time-limit/2 \\ lift $ max 1 $ inexact->exact $ floor { random-time-limit / 2 }
        ! cond
        !   screen-ref(numbers i letter) $ kdo
        !   ! lift $ begin
        !   !   vector-set! letters i -{ 10 + random(random-time-limit/2)}
        !   !   screen-set! numbers i letter #f
        !   !   set-pressure-state! st { pressure-state(st) + 1 }
        !   !   '()
        !   { letter = 0 } $ kdo
        !   ! ; at top, so setup reload time
        !   ! lift $ begin
        !   !   vector-set! letters i -{ 10 + random(random-time-limit) }
        !   !   '()
        !   screen-ref(numbers i { letter - 1 }) $ kdo
        !   ! gotoxy { 7 + i } { letter - 1 }
        !   ! print " "
        !   ! lift $ begin
        !   !   vector-set! letters i -{ 10 + random(random-time-limit/2)}
        !   !   screen-set! numbers i { letter - 1 } #f
        !   !   set-pressure-state! st { pressure-state(st) + 1 }
        !   !   '()
        !   else $ kdo
        !   ! ; go up a step
        !   ! gotoxy { 7 + i } { letter - 1 }
        !   ! print char
        !   ! lift $ begin
        !   !   vector-set! letters i { letter - 1 }
        !   !   '()
        ;
        ; letter will now reload?
        { letter = -1 } $ kdo
        ! gotoxy { 7 + i } 24
        ! print char
        ! lift $ begin
        !   vector-set! letters i 24
        !   '()
        ;
        ; letter is reloading?
        else $ kdo
        ! lift $ begin
        !   vector-set! letters i { 1 + letter }
        !   '()
  ;
  ; handle snipers
  let snipe \\ lift '#f
  ; sniper1
  cond
    sniper1-state(st) $ kdo
      if { sniper1-state(st) = 1 }
        kdo
          lift $ begin
            set-sniper1-state! st #f
            '()
          gotoxy 0 24
          print "READY/"
        lift $ begin
          set-sniper1-state! st { sniper1-state(st) - 1 }
          '()
    { k and char-numeric?(k) } $ kdo
      gotoxy 0 24
      print "RELOAD"
      lift $ begin
        set-sniper1-state! st { 80 + random{ 1 + current-pressure } }
        set! snipe { char->integer(k) - 48 }
        set! k #f ; take the number
        '()
    else $ lift '()
  ; sniper2
  cond
    sniper2-state(st) $ kdo
      if { sniper2-state(st) = 1 }
        kdo
          lift $ begin
            set-sniper2-state! st #f
            '()
          gotoxy 34 24
          print "\\READY"
        lift $ begin
          set-sniper2-state! st { sniper2-state(st) - 1 }
          '()
    { k and char-numeric?(k) } $ kdo
      gotoxy 34 24
      print "RELOAD"
      lift $ begin
        set-sniper2-state! st { 80 + random{ 1 + current-pressure } }
        set! snipe { char->integer(k) - 48 }
        set! k #f ; take the number
        '()
    else $ lift '()
  ;
  ; handle numbers
  let number-count \\ lift 0 ; number of surviving numbers found
  for-i-k 26 $ lambda (x)
    ; do y traversals in reverse order.  Needed so that lower
    ; numbers are handled first and falling numbers do not
    ; inadvertently get handled twice.
    for-reverse-i-k 24 $ lambda (y) $ kdo
      let number \\ lift $ screen-ref numbers x y
      cond
        { number and snipe and { snipe = actual-number(number) }} $ kdo
          ; sniped!!
          gotoxy { 7 + x } y
          print " "
          lift $ begin
            screen-set! numbers x y #f
            set-pressure-state! st { 1 + pressure-state(st)}
            '()
        number $ kdo
          ; set number-count
          lift $ begin
            set! number-count { number-count + 1 }
            '()
          ; check if time to drop the number
          let time \\ lift $ time-number number
          if { time = 1 }
            ; drop now!
            kdo
              gotoxy { 7 + x } y
              print " "
              drop-number-at st numbers x y
            ; else update
            lift $ begin
              set-time-number! number { time - 1 }
              '()
        else $ lift '()
  ;
  ; add new numbers
  ; Always add new numbers if there are no numbers yet.
  ; Also, add number based on pressure.
  cond
    not(current-pressure) $ lift '()
    { number-count >= 7 } $ lift '()
    { { number-count = 0 } or { current-pressure > random{current-pressure + 1000}}} $ kdo
      let x-number \\ lift
      ! let*
      !   \\
      !   ! x         $ random 26
      !   ! n         $ random 10
      !   ! max-speed $ inexact->exact $ floor $ max 4
      !   !           !   {{ 0.95 expt pressure-state(st)} * 16 }
      !   ! min-speed $ inexact->exact $ floor $ max 2 $ { max-speed / 2 }
      !   ! speed     $ { min-speed + random{{max-speed - min-speed} + 1 }}
      !   ! number    $ falling-number speed speed n
      !   screen-set! numbers x 0 number
      !   list x n
      let x \\ lift $ list-ref x-number 0
      let n \\ lift $ list-ref x-number 1
      gotoxy { 7 + x } 0
      print n
    else $ lift '()
  ;
  ; refresh screen
  refresh-screen
  if pressure-state(st)
    game-loop st
    lift '()

define drop-number-at(st numbers x y) $ cond
  screen-ref(numbers x y) $ kdo
  ! let number \\ lift $ screen-ref numbers x y
  ! ; drop it
  ! cond
  !   { y = 23 } $ kdo
  !   ! ; destroy letter or game over
  !   ! let letters \\ lift $ letters-state st
  !   ! if vector-ref(letters x)
  !   !   kdo
  !   !     lift $ begin
  !   !       screen-set! numbers x y #f
  !   !       vector-set! letters x #f
  !   !       '()
  !   !     gotoxy { 7 + x } 24
  !   !     print "*"
  !   !   kdo
  !   !     lift $ begin
  !   !       screen-set! numbers x y #f
  !   !       set-pressure-state! st #f
  !   !       '()
  !   !     complete-render st
  !   !     gotoxy { 7 + x } 24
  !   !     print $ actual-number $ number
  !   !     refresh-screen
  !   else $ kdo
  !   ! ; something might be under us, drop it too.
  !   ! drop-number-at st numbers x { y + 1 }
  !   ! ; we now know that the lower location is
  !   ! ; clear, so go into it, clear out our
  !   ! ; previous location, and reset our time.
  !   ! let number \\ lift $ screen-ref numbers x y
  !   ! lift $ begin
  !   !   screen-set! numbers x { y + 1 } number
  !   !   screen-set! numbers x y #f
  !   !   set-time-number! number $ speed-number number
  !   !   '()
  !   ! ; update the screen
  !   ! gotoxy { 7 + x } y         \\ print " "
  !   ! gotoxy { 7 + x } { y + 1 } \\ print $ actual-number number
  else $ lift '()

; used only to completely render the screen,
; usually only at start of game or after
; pausing.
define complete-render(st) $ kdo
  cls
  ; render letters
  let letters \\ lift $ letters-state st
  for-i-k 26 $ lambda (i)
    let
      $ letter $ vector-ref letters i
      cond
        not(letter)     $ kdo
          gotoxy { 7 + i } 24
          print "*"
        { letter >= 0 } $ kdo
          gotoxy { 7 + i } letter
          print $ integer->char { 65 + i }
        else            $ kdo
          lift '() ; reloading, print nothing
  ; render snipers
  let sniper1 \\ lift $ sniper1-state st
  let sniper2 \\ lift $ sniper2-state st
  gotoxy 0 24
  if sniper1
    print "RELOAD"
    print "READY/"
  gotoxy 34 24
  if sniper2
    print "RELOAD"
    print "\\READY"
  ; render numbers
  let numbers \\ lift $ numbers-state st
  for-i-k 26 $ lambda (x)
    for-i-k 24 $ lambda (y) $ kdo
      let number \\ lift $ screen-ref numbers x y
      cond
        number $ kdo
          gotoxy { 7 + x } y
          print $ actual-number number
        else   $ kdo
          lift '()
  ; render game over if needed
  if pressure-state(st)
    lift '()
    center 21 "!!! GAME OVER !!!"
  refresh-screen

; get a key if available
define try-get-key $ kdo
  lift '()
  let c \\ key-available?
  if c
    get-key
    lift '#f

;-----

define for-i-k(n kf)
  define inner(i) $ cond
    { i = n } $ lift '()
    else      $ kdo
      kf i
      inner { i + 1 }
  inner 0
define for-reverse-i-k(n kf) $ cond
  { n <= 0 } $ lift '()
  else       $ kdo
    kf { n - 1 }
    for-reverse-i-k { n - 1 } kf
define screen-ref(v x y)
  vector-ref v { x + { y * 26 }}
define screen-set!(v x y nv)
  vector-set! v {x + { y * 26 }} nv

define char-toupper(c)
  let
    $ n $ char->integer c
    cond
      {{ 96 < n } and { n <= { 96 + 26 }}}
        integer->char $ { n - 32 }
      #t $ c
define char-numeric?(c)
  let
    $ n $ char->integer c
    {{ 48 <= n} and { n <= { 48 + 9 }}}

