'===========================================================================
' Subject: CRAZY                             Date: 06-24-98 (07:19)       
' Author:  Henrik H”gberg                    Code: QB, QBasic, PDS        
' Origin:  hh@ljungby.mail.telia.com       Packet: GAMES.ABC
'===========================================================================
DECLARE FUNCTION USCORE% (SCORE%, MX%)
DECLARE FUNCTION PRUTA% (SX%, SY%, MX%, MY%)
DECLARE FUNCTION CRUTA% (SX%, SY%, MX%, MY%)
DECLARE FUNCTION URUTA% (XK%, YK%, CT$)
DEFINT A-Z

' CRAZY
' Programming and design by
' Henrik H”gberg, also known as Zanius of TMP
' Ideas and mental support by
' Ricky Hansen, also known as LaZy JoNes

' Copyright 1998 (C) Henrik H”gberg
' Feel free to play with this code but please give me
' some credits for it. =) The time is now halfpast six
' in the morning, I begun writing this game about halfpast
' two in the morning so don't complain about any bugs. ;)

' You can reach me at this E-mail address
' hh@ljungby.mail.telia.com
' or...
' tmpzanius@hotmail.com

' Instructions:
' When you see a letter dropping, press that letter on the keyboard
' as fast as you can. If you fail, the letter will drop to the ground
' and stay there. When the level of the letters is too high, you've
' lost the game. If you fails twice in a row you will get punished
' with a blocking line. The meaning of this game is somewhat unknown
' but I've heard that if you've managed to get 100000 points, you've
' wone. =) You will probably get very good at typing when you have
' played this game a couple of hundred times so... AAAHHH! Almost
' forgot, you will have 10000 points when you start and for every
' failure you will lose 500 and for every smash hit you will get
' 100 points plus time bonus. If your score goes below 0, you lose.
' GOOD LUCK!!!

SCREEN 8

CONST MX = 30
CONST MY = 20

DIM SHARED RUTA$(MX, MY)

AGAIN:
CLS

'a - 97
'z - 122

A = CRUTA(1, 1, MX, MY)
A = PRUTA(1, 1, MX, MY)

SPS# = .2
SPP# = SPS#
SCORE = 10000
A = USCORE(SCORE, MX)
COLOR 4
LOCATE 2, MX + 2
PRINT "Failures:"; FAIL
COLOR 10
LOCATE 3, MX + 2
PRINT "Correct:"; OK
RESTORE LOGO
FOR LY = 1 TO 10
 FOR LX = 1 TO 30
  READ P
  PSET ((LX * 5 + 240), (LY * 5 + 100)), P
 NEXT LX
NEXT LY
COLOR 5
LOCATE MY + 2, 8
PRINT "CRAZY - Programming & design by Henrik H”gberg - Zanius of TMP"
PRINT "        Ideas and mental support by Ricky Hansen - LaZy JoNes"

COLOR 3
LOCATE 8, 55
PRINT "Press . during game to"
LOCATE 9, 55
PRINT "quit the session."
LOCATE 11, 55
PRINT "Press q to quit"

COLOR 15, 0
LINE (240, 1)-(240, 160)
LINE (240, 160)-(1, 160)
LINE (241, 160)-(640, 160)
LINE (399, 160)-(399, 101)
LINE (241, 99)-(401, 99)
COLOR 8, 0
LINE (242, 1)-(242, 161)
LINE (241, 1)-(241, 161)
LINE (241, 161)-(1, 161)
LINE (241, 161)-(640, 161)
LINE (400, 161)-(400, 100)
LINE (401, 161)-(401, 100)
LINE (241, 100)-(401, 100)

IF NG = 0 THEN GOTO NGAME

PLAY "O3L16CEGDF#AEG#B"

DO

SP# = SPS#

R = 0
DO
 R = RND * 35
LOOP UNTIL R >= 1 AND R <= MX
X = R

R = 0
DO
 R = RND * 200
LOOP UNTIL R >= 97 AND R <= 122
RK$ = CHR$(R)

T1# = TIMER
FOR Y = 1 TO MY
 T2# = TIMER

 SOUND 200 + (Y * 20), .5

 COLOR (Y / 2) + 1, 0

 IF RUTA$(X, Y) <> " " THEN
  GOTO PILE
 END IF

 IF Y > 1 THEN
  A = URUTA(X, Y - 1, " ")
  RUTA$(X, Y - 1) = " "
  A = URUTA(X, Y, RK$)
  RUTA$(X, Y) = RK$
  ELSE
  A = URUTA(X, Y, RK$)
  RUTA$(X, Y) = RK$
 END IF

 T3# = TIMER
 WHILE T3# - T2# < SP#
  T3# = TIMER
 WEND

 I$ = INKEY$
 IF I$ <> "" THEN
  IF I$ = "." THEN GOTO LOSER
  IF I$ = RK$ THEN
   RUTA$(X, Y) = " "
   A = URUTA(X, Y, " ")
   GOTO SCORE
  END IF
  IF I$ <> RK$ THEN
   SCNT = SCNT + 1
   IF SCNT = 3 THEN
    FAIL = FAIL + 1
    COLOR 4
    LOCATE 2, MX + 2
    PRINT "Failures:"; FAIL
    SOUND 800, 2
    DO
     FOR DX = 1 TO MX
      FOR DY = MY TO 1 STEP -1
       IF RUTA$(DX, DY - 1) = " " AND RUTA$(DX, DY) <> "*" THEN
        RUTA$(DX, DY - 1) = "*"
        ZET = ZET + 1
        A = URUTA(DX, DY - 1, "*")
        GOTO FOUND
       END IF
      NEXT DY
FOUND:
     NEXT DX
    LOOP UNTIL ZET >= MX
    ZET = 0
    SCNT = 0
    SOUND 300, 2
   END IF
   SP# = 0
   SPS# = SPP#
  END IF
 END IF

NEXT Y
PILE:
SCORE = SCORE - 500
IF SCORE <= 0 THEN GOTO LOSER
A = USCORE(SCORE, MX)
FAIL = FAIL + 1
COLOR 4
LOCATE 2, MX + 2
PRINT "Failures:"; FAIL
SPS# = SPP#
IF Y < 3 THEN GOTO LOSER

GOTO NADA

SCORE:
SCORE = SCORE + 100 + (100 / Y)
OK = OK + 1
COLOR 10
LOCATE 3, MX + 2
PRINT "Correct:"; OK
IF SCORE >= 100000 THEN GOTO WINNER
IF CNT = 1 AND SPS# > .02 THEN
 SPS# = SPS# - .01
 CNT = 0
ELSE
 CNT = CNT + 1
END IF

A = USCORE(SCORE, MX)

NADA:
LOOP

END
LOSER:
PLAY "O3L16CD#GDFA"
PLAY "O3L64BA#AG#GF#FED#DC"
NGAME:
NG = 1
DO
 COLOR 14, 0
 LOCATE 8, 11
 PRINT "GAME OVER"
 LOCATE 10, 6
 PRINT "NEW GAME - PRESS N!"
 SLEEP 1
 I$ = INKEY$
 IF I$ = "n" THEN GOTO AGAIN
 IF I$ = "q" THEN CLS : END
 COLOR 8, 0
 LOCATE 8, 11
 PRINT "GAME OVER"
 LOCATE 10, 6
 PRINT "NEW GAME - PRESS N!"
 SLEEP 1
 I$ = INKEY$
 IF I$ = "n" THEN GOTO AGAIN
 IF I$ = "q" THEN CLS : END
LOOP
CLS
END
WINNER:
CLS
A = 1
FOR I = 1 TO 100
 COLOR A
 PRINT "CONGRATULATIONS! ";
 A = A + 1
 IF A = 16 THEN A = 1
NEXT I
PLAY "L16O1CEGO2CEGO3CEGO4CEGO5CEG"
SLEEP 30
END

LOGO:
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,1,1,1,0,0,0,0,0,0,0,1,1,0,3,3,3,3,3,0,0,0,0,0,0,0,0
DATA 0,0,0,1,0,0,2,1,0,5,5,5,0,1,0,2,1,0,0,0,2,3,0,1,0,0,0,1,0,0
DATA 0,0,1,2,0,0,0,0,0,5,0,2,5,1,0,0,1,0,0,0,3,0,0,1,0,0,0,1,0,0
DATA 0,0,1,2,0,0,0,0,0,5,0,0,5,1,2,2,1,0,0,3,0,0,0,1,2,0,2,1,0,0
DATA 0,0,1,2,0,0,0,0,0,5,5,5,0,1,0,0,1,2,3,0,0,0,0,0,1,2,1,0,0,0
DATA 0,0,1,2,0,0,0,2,1,5,0,2,5,1,0,0,1,3,3,3,3,3,0,0,2,1,2,0,0,0
DATA 0,0,1,2,0,0,2,1,0,5,1,0,5,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0
DATA 0,0,0,1,1,1,1,0,0,5,1,0,5,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

FUNCTION CRUTA (SX, SY, MX, MY)
FOR Y = SX TO MY
 FOR X = SY TO MX
  RUTA$(X, Y) = " "
 NEXT X
NEXT Y
END FUNCTION

FUNCTION PRUTA (SX, SY, MX, MY)
 FOR Y = SX TO MY
  FOR X = SY TO MX
   LOCATE Y, X
   PRINT RUTA$(X, Y)
  NEXT X
 NEXT Y
END FUNCTION

FUNCTION URUTA (XK, YK, CT$)
RUTA$(XK, YK) = CT$
LOCATE YK, XK
PRINT CT$
END FUNCTION

FUNCTION USCORE (SCORE, MX)
COLOR 14, 0
LOCATE 1, MX + 2
PRINT "Score:"; STR$(SCORE); "         "
END FUNCTION