
; letterfall/main.sscm - main driver
; 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 main
  :export
  \\
    main

use-modules
  letterfall kont
  letterfall kgtk

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 kmain $ kdo
  kgtk-start "Letterfall"
  kmain-loop
define kmain-loop $ kdo
  lift '()
  title-screen
  play-game
  kmain-loop
define title-screen $ kdo
  lift '()
  center 8 "LETTERFALL"
  center 16 "TYPE 'PLAY' TO START"
  refresh-screen
  wait-for-play
define wait-for-play $ kdo
  lift '()
  wait-for-play-loop 17 '(#\P #\L #\A #\Y)
define wait-for-play-loop(col cs) $ cond
  null?(cs) $ lift '()
  #t        $ kdo
    let c \\ lift $ car cs
    let k \\ get-key
    if { char-toupper(k) char=? c }
       kdo
         gotoxy col 18
         print c
         refresh-screen
         wait-for-play-loop { col + 1 } $ cdr cs
       wait-for-play-loop col cs

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 play-game $ kdo
  lift '()
  init-screen
  refresh-screen
  game-loop 0 0

define init-screen $ kdo
  lift '()
  cls
  gotoxy 7 0
  print "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  gotoxy 7 23
  print "--------------------------"

define print-score(level score) $ kdo
  center 24 $ format #f "LVL ~A  SCORE ~A" level score
  refresh-screen

define game-loop(level score) $ kdo
  print-score level score
  drop-letter (random 26) level score

define drop-letter(n level score)
  drop-letter-loop { 7 + n } 0 integer->char({ 64 + n + 1 }) level score

define drop-letter-loop(col line char level score) $ kdo
  let check \\ key-available?
  if check
     kdo
       let k \\ get-key
       cond
        { char-toupper(k) char=? char }
        ! kdo
        !   ; a hit! a palpable hit!
        !   gotoxy col line
        !   print " "
        !   gotoxy col 0
        !   print char
        !   let nscore \\ lift { score + 1 }
        !   if {{ nscore remainder 10 } = 0 }
        !      game-loop { level + 1 } nscore
        !      game-loop level nscore
        { k char=? esc-key }
        ! kdo
        !   ; pause the game
        !   pause col line char
        !   drop-letter-loop col line char level score
        #t
          kdo
            ; wrong key; ignore
            drop-letter-loop col line char level score
     kdo
       ; drop!
       wait $ speed-at level
       gotoxy col line
       print " "
       gotoxy col { line + 1 }
       print char
       refresh-screen
       if { line = 22 }
          ; game over!
          kdo
            center 21 "- GAME OVER -"
            refresh-screen
          ; keep going...
          drop-letter-loop col { line + 1 } char level score

define pause(col line char) $ kdo
  center 8 "- PAUSED -"
  refresh-screen
  wait-for-escape
  center 8 "          "
  ; replace as it might have gotten erased
  gotoxy col line
  print char
  refresh-screen
define wait-for-escape $ kdo
  let k \\ get-key
  if { k char=? esc-key }
     lift '()
     wait-for-escape

define speed-at(level)
  inexact->exact $ floor
    max 25
        {{ 0.75 expt level } * 400 }

;-----

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

; vim: set ft=scheme : ;
