DEFINT A-Z

DECLARE FUNCTION KlarText$ (Text$)
DECLARE SUB Center80 (Rad%, Text$)
DECLARE SUB HighScore (Byte&)
DECLARE SUB Siren (Hi%, Range%)
DECLARE SUB Control ()
DECLARE FUNCTION Pris% (ColorNum%)
DECLARE SUB Box2 (Row1%, Col1%, Row2%, Col2%)
DECLARE SUB RitaBana2 ()
DECLARE SUB FlyttaTjuv (Bana%, Stopp%, StartSek&, Byte&)
DECLARE SUB RitaBana1 ()
DECLARE FUNCTION Slump% (Min%, max%, Ej%)
DECLARE SUB Fyll (Bana%)
DECLARE SUB Center (Rad%, Text$)
DECLARE SUB Help (AktBana%)

OPTION BASE 1

CONST True = -1, False = 0
CONST ForG = 4, BakG = 3

DIM SHARED Bana

IF COMMAND$ = "MEGAHIT" THEN
  Megahit = -1
ELSE
  Megahit = 0
END IF

'ON ERROR GOTO Fel

Control

Fel:
  WIDTH 80
  COLOR 7, 0
  CLS
  BEEP
  PRINT "Ett fel uppkom n„r programmet k”rdes."
  PRINT "Felet har felkod"; STR$(ERR); "."
'  PRINT "F”r att hindra att andra f†r felet, skriv till f”ljande adress och ber„tta"
'  PRINT "hur och n„r felet uppkom samt vilket nummer felet har s† ska det f”rhoppnings-"
'  PRINT "vis vara fixat i n„sta version."
'  PRINT
'  PRINT "     2GOOD Productions"
'  PRINT "     David Eriksson"
'  PRINT "     Alk„rrsgatan 9"
'  PRINT "     603 64 NORRK™PING"
'  PRINT
'  PRINT "Om du tror att du kan r„tta till felet sj„lv, g”r det, och skriv hur du gjorde!"
'  PRINT "OBS! Gl”m inte att ange att du fick felet i Diamanttjuvar 2.0!"
'  PRINT
  END

DEFINT A-Z
SUB Box2 (Row1, Col1, Row2, Col2)

    BoxWidth = Col2 - Col1 + 1

    LOCATE Row1, Col1
    PRINT "Û"; STRING$(BoxWidth - 2, "Û"); "Û";

    FOR A = Row1 + 1 TO Row2 - 1
        LOCATE A, Col1
        PRINT "Û"; SPACE$(BoxWidth - 2); "Û";
    NEXT A

    LOCATE Row2, Col1
    PRINT "Û"; STRING$(BoxWidth - 2, "Û"); "Û";

END SUB

DEFINT A-Z
SUB Center (Rad, Text$)
 
  LOCATE Rad, 21 - LEN(Text$) / 2
  PRINT Text$;

END SUB

DEFINT A-Z
SUB Center80 (Rad, Text$)

'  LOCATE Rad, 41 - LEN(Text$) / 2
'  PRINT Text$;

END SUB

DEFINT A-Z
SUB Control ()
SHARED Igen, Diam&

  IF Igen THEN GOTO Spela

  SCREEN 0
  WIDTH 40, 25
  COLOR ForG, BakG: CLS
 
  Center 4, "D I A M A N T T J U V A R"
  Center 6, "I  F A R T E N"
  Center 8, "Version 2.1 "
  Center 15, "Gjort av 2GOOD Productions 1992."
  Center 23, "Tryck p† valfri tangent..."

  WHILE INKEY$ = "": WEND

  CLS
'  OPEN "REG.DAT" FOR BINARY AS #2
'  Till$ = SPACE$(20): GET #2, , Till$
'  Num$ = SPACE$(10): GET #2, , Num$
'  CLOSE
'  LOCATE 5, 1: PRINT " Registrerad till: "; KlarText$(Till$)
'  LOCATE 7, 1: PRINT " Nummer: "; KlarText$(Num$)
  Center 17, "Tryck p† Escape"
  Center 19, "f”r att avbryta spelet n„r du k”r."
  Center 22, "Tryck p† valfri tangent f”r att b”rja."
  WHILE INKEY$ = "": WEND
 
Spela:
  RANDOMIZE TIMER
  StartSek& = TIMER
'  Tid = 300
  Bana = 1

  DO
    CLS

    IF Bana = 3 THEN Bana = 0
    IF Bana = 1 THEN
      RitaBana1
    ELSEIF Bana = 2 THEN
      RitaBana2
    ELSE
      GOTO SpelatKlart
    END IF
   
    Fyll Bana

    WHILE INKEY$ <> "": WEND
    FlyttaTjuv Bana, Stopp, StartSek&, Byte&
    IF Stopp THEN GOTO Escape
    IF Byte& = 0 THEN GOTO SpelatKlart
    IF Byte& = -1 THEN GOTO BlivitFast
  LOOP

SpelatKlart:
  CLS
  Center 1, "Du „r ute!"
  'Byte& = 1000 * Diam&
  LOCATE 3, 1
  Center 3, "Du fick ihop" + STR$(Byte&) + " kronor!"
  HighScore (Byte&)
  GOTO Igen

Escape:
  CLS
  Center 5, "Du avbr”t..."
  GOTO Igen

BlivitFast:
  CLS
  Center 10, "Du sitter i f„ngelse ett tag nu."
  Center 12, "Sen kan du f”rs”ka igen!"
  Center 20, "Tryck p† en tangent f”r att forts„tta."
  DO WHILE INKEY$ = ""
    Siren 780, 650
  LOOP
'  GOTO Igen

Igen:
  Center 23, "Vill du k”ra igen? (J/N)"
  Kbd$ = ""
  WHILE NOT Kbd$ = "J" AND NOT Kbd$ = "N"
    Kbd$ = UCASE$(INKEY$)
  WEND
  IF Kbd$ = "J" THEN Byte& = 0: GOTO Spela
'  GOTO Sluta

Sluta:
  WIDTH 80
'  COLOR ForG + 16, BakG: CLS
'  IF NOT KlarText$(Till$) = "OREGISTRERAT EXEMPLAR" AND NOT KlarText$(Till$) = SPACE$(20) THEN GOTO Slut
'  Center80 5, "Detta „r ej ett gratisspel!"
'  COLOR ForG
'  PRINT : PRINT
'  PRINT " Om du efter att ha testat detta spel i max 20 dagar ska du betala en"
'  PRINT " registreringsavgift p† endast 40:- f”r att f† forts„tta att anv„nda spelet."
'  Center80 CSRLIN + 1, "Avgiften skickas till f”ljande adress:"
'  Center80 CSRLIN + 2, "2GOOD Productions"
'  Center80 CSRLIN + 1, "David Eriksson   "
'  Center80 CSRLIN + 1, "Alk„rrsgatan 9   "
'  Center80 CSRLIN + 1, "603 64 NORRK™PING"
'  Center80 CSRLIN + 2, " M„rk kuvertet " + CHR$(34) + "Diamanttjuvar" + CHR$(34)

Slut:
  COLOR 7, 0: CLS
  VIEW PRINT 24 TO 25: CLS 2
  VIEW PRINT
  LOCATE 24, 1
  END

END SUB

DEFINT A-Z
SUB FlyttaTjuv (Bana, Stopp, StartSek&, Byte&)
SHARED Megahit

Hoger$ = CHR$(0) + "K": Vanster$ = CHR$(0) + "M"
Upp$ = CHR$(0) + "H": Ner$ = CHR$(0) + "P"
F1$ = CHR$(0) + ";"

'Bana = Bana + 1

IF Bana = 1 THEN
  Rad = 3: Kol = 3
ELSEIF Bana = 2 THEN
  Rad = 13: Kol = 21
END IF

DO
  LOCATE Rad, Kol: PRINT "œ"
  LOCATE 1, 2: PRINT "Tid: "
  LOCATE 1, 25: PRINT "Byte: ";
  PRINT USING "#######"; Byte&
  Ink$ = ""
  WHILE Ink$ = ""
   
    Sek = TIMER - StartSek&
    LOCATE 1, 7: PRINT USING "####"; Sek; '"av"; Tid
    IF Sek = 110 THEN
      Temp& = TIMER
      Siren 780, 650
      Center 24, "Du h”r polissir‚ner! Skynda p†!"
      Siren 780, 650
      Center 24, "                               "
      StartSek& = StartSek& + (TIMER - Temp&) - 1
    END IF
    IF Sek = 150 THEN
      Temp& = TIMER
      Siren 780, 650
      Center 24, "Poliserna „r inte l†ngt borta."
      Center 25, "Ut, och det snabbt!"
      StartSek& = StartSek& + (TIMER - Temp&) - 1
    END IF
    IF Sek = 165 THEN
      Center 25, "                   "
      Center 24, "Poliserna v„ntar utanf”r. Du „r fast!"
      Siren 780, 650
      Siren 780, 650
      Byte& = -1: EXIT SUB
    END IF

    Ink$ = INKEY$
  WEND
  LOCATE Rad, Kol: PRINT " "
  SELECT CASE Ink$
    CASE F1$
      Temp& = TIMER
      Help 0 'Bana
      StartSek& = StartSek& + (TIMER - Temp&)
    CASE Hoger$
      IF NOT SCREEN(Rad, Kol - 1) = 219 THEN Kol = Kol - 1
    CASE Vanster$
      IF NOT SCREEN(Rad, Kol + 1) = 219 THEN Kol = Kol + 1
    CASE Upp$
      IF Bana = 2 AND NOT SCREEN(Rad - 1, Kol) = 219 THEN Rad = Rad - 1
    CASE Ner$
      IF Bana = 2 AND NOT SCREEN(Rad + 1, Kol) = 219 THEN Rad = Rad + 1
    CASE " "
      IF Bana = 1 THEN GOSUB Hoppa
    CASE "+": IF Megahit AND TIMER - StartSek& > 0 THEN StartSek& = StartSek& + 1
    CASE "-": IF Megahit THEN StartSek& = StartSek& - 1
    CASE CHR$(27): Stopp = True: EXIT SUB
    CASE ELSE
  END SELECT
  SELECT CASE CHR$(SCREEN(Rad, Kol))
    CASE "*"
      Num = SCREEN(Rad, Kol, True)
      Byte& = Byte& + Pris(Num)
    CASE "", "": Bana = Bana + 1: EXIT SUB
    CASE " ", "œ"
    CASE "Û": STOP
    CASE ELSE: STOP
  END SELECT
  IF Bana = 1 AND SCREEN(Rad + 1, Kol) = 32 THEN
    LOCATE Rad, Kol: PRINT " "
    Rad = Rad + 3
  END IF
LOOP

Hoppa:
  IF SCREEN(Rad - 1, Kol) = ASC("*") THEN
    Num = SCREEN(Rad - 1, Kol, True)
    Byte& = Byte& + Pris(Num)
  END IF
  LOCATE Rad - 1, Kol: PRINT "œ"
  FOR A& = 1 TO 12500: NEXT           'QB: A,15000 - EXE: A&,12500
  LOCATE Rad - 1, Kol: PRINT " "
  LOCATE Rad, Kol: PRINT "œ"
  RETURN

END SUB

DEFINT A-Z
SUB Fyll (Bana)

  DIM C(5)
  C(1) = 4: C(2) = 2: C(3) = 15: C(4) = 14
 
  COLOR ForG, BakG
 
  IF Bana = 1 THEN
   
    FOR A = 2 TO 21 STEP 3
      FOR B = 1 TO 5
        DO
          Sp = Slump(4, 37, 0)
        LOOP WHILE NOT SCREEN(A, Sp) = 32
        COLOR C(B): LOCATE A, Sp: PRINT "*"
      NEXT B
      FOR B = 1 TO 5
        DO
          Sp = Slump(3, 38, 0)
        LOOP WHILE NOT SCREEN(A, Sp) = 32
        COLOR C(B): LOCATE A + 1, Sp: PRINT "*"
      NEXT B
    NEXT A
 
  ELSEIF Bana = 2 THEN
   
    FOR A = 3 TO 21 STEP 3
      FOR B = 1 TO 5
        DO
          Sp = Slump(3, 38, 0)
        LOOP WHILE NOT SCREEN(A, Sp) = 32
        COLOR C(B): LOCATE A, Sp: PRINT "*"
      NEXT B
      FOR B = 1 TO 5
        DO
          Sp = Slump(3, 38, 0)
        LOOP WHILE NOT SCREEN(A, Sp) = 32
        COLOR C(B): LOCATE A + 1, Sp: PRINT "*"
      NEXT B
    NEXT A
 
  END IF
   
  COLOR ForG, BakG

END SUB

DEFINT A-Z
SUB Help (AktHelp)
'AktHelp = AktHelp + 1

  SCREEN , , 1, 0
  COLOR ForG, BakG: CLS
  Center 1, "Hj„lp"
  PRINT STRING$(40, "Ä");
  SELECT CASE AktHelp
    CASE 0: GOSUB StartHelp
    CASE 1: GOSUB Bana1
    CASE 2: GOSUB Bana2
    CASE ELSE
  END SELECT
  COLOR ForG, BakG
  Center 24, "Tryck p† en tangent f”r att forts„tta."
  SCREEN , , 1, 1
  WHILE INKEY$ = "": WEND
  SCREEN , , 0, 0
  COLOR ForG, BakG
  EXIT SUB

StartHelp:
    Center CSRLIN, " Bana 1: V†ningarna (Fr†n sidan)"
    PRINT
    PRINT " G† med h”ger- och v„nsterpilarna."
    PRINT " Hoppa med mellanslag."
    PRINT STRING$(40, "Ä");
    Center CSRLIN, " Bana 2: Labyrinten (Uppifr†n)"
    PRINT
    PRINT " G† med alla piltangenter. H„r hoppar"
    PRINT " du inte."
    PRINT STRING$(40, "Ä");
    PRINT " Ta s† m†nga diamanter som m”jligt."
    PRINT " Med Escape avslutar du inne i ett"
    PRINT " spel."
    PRINT
    Lin = CSRLIN
    PRINT "   = 5000 kr"
    PRINT "   = 4000 kr"
    PRINT "   = 3000 kr"
    PRINT "   = 2000 kr"
    PRINT "   = 1000 kr"
    COLOR 15: LOCATE Lin, 2: PRINT "*"
    COLOR 4: LOCATE Lin + 1, 2: PRINT "*"
    COLOR 2: LOCATE Lin + 2, 2: PRINT "*"
    COLOR 14: LOCATE Lin + 3, 2: PRINT "*"
    COLOR 0: LOCATE Lin + 4, 2: PRINT "*"
    RETURN

Bana1:
  Center CSRLIN, " Bana 1: V†ningarna (Fr†n sidan)"
  PRINT
  PRINT " G† med h”ger- och v„nsterpilarna."
  PRINT " Hoppa med mellanslag."
  PRINT STRING$(40, "Ä");
  RETURN

Bana2:
  Center CSRLIN, " Bana 2: Labyrinten (Uppifr†n)"
  PRINT
  PRINT " G† med alla piltangenter. H„r hoppar"
  PRINT " du inte."
  PRINT STRING$(40, "Ä");
  RETURN

END SUB

DEFINT A-Z
SUB HighScore (Byte&)

DIM Namn$(10), P&(10)

Center 5, "H„r „r de 10 b„sta tjuvarna:"
PRINT : PRINT
PRINT SPC(6); "Namn:"; SPC(17); "Po„ng:"
PRINT STRING$(40, "Ä");

OPEN "DITJUV.TOP" FOR RANDOM AS #1
FIELD #1, 20 AS Namn$, 10 AS P$

FOR E = 1 TO 10
  GET #1, E
  Namn$(E) = Namn$
  P&(E) = VAL(P$)
  PRINT USING "##"; E;
  PRINT ". " + Namn$(E); " ";
  PRINT USING "######"; P&(E)
'  IF E = 10 THEN
'    PRINT E; ". "; Namn$(E); " "; P&(E)
'  ELSE
'    PRINT " "; E; ". "; Namn$(E); " "; P&(E)
'  END IF
NEXT E
PRINT STRING$(40, "Ä");
FOR f = 1 TO 10
  IF Byte& >= P&(f) THEN
    INPUT "Ange namn: ", n$
    LSET Namn$ = n$
    LSET P$ = STR$(Byte&)
    PUT #1, f
    IF f <> 10 THEN
      FOR g = f + 1 TO 10
        LSET Namn$ = Namn$(g - 1)
        LSET P$ = STR$(P&(g - 1))
        PUT #1, g
      NEXT g
    END IF
    CLOSE
    EXIT FOR
  END IF
NEXT f
CLOSE

END SUB

DEFINT A-Z
FUNCTION KlarText$ (Text$)

  FOR A = 1 TO LEN(Text$)
    NyText$ = NyText$ + CHR$(ASC(MID$(Text$, A, 1)) + 32)
  NEXT A
  KlarText$ = NyText$

END FUNCTION

DEFINT A-Z
FUNCTION Pris (ColorNum)

  SELECT CASE ColorNum
    CASE 0 + (BakG * 16)
      P = 1000
    CASE 1 + (BakG * 16)
      P = 2000
    CASE 2 + (BakG * 16)
      P = 3000
    CASE 4 + (BakG * 16)
      P = 4000
    CASE 14 + (BakG * 16)
      P = 2000
    CASE 15 + (BakG * 16)
      P = 5000
  CASE ELSE: STOP
  END SELECT

  Pris = P

END FUNCTION

DEFINT A-Z
SUB RitaBana1 ()
 
  PRINT
  FOR A = 1 TO 7
    PRINT "ÛÛ"; SPC(36); "ÛÛ";
    PRINT "ÛÛ"; SPC(36); "ÛÛ";
    PRINT STRING$(40, "Û");
  NEXT A

'  Fyll Bana
  FOR A = 4 TO 20
    IF A MOD 2 THEN LOCATE A, 3 ELSE LOCATE A, 38
    PRINT " ";
  NEXT A
  Rad = 3: Teck = 15

  COLOR 15, 2: LOCATE 21, 1: PRINT CHR$(27);
  COLOR ForG, BakG: PRINT " ";

END SUB

DEFINT A-Z
SUB RitaBana2 ()

  Box2 2, 1, 23, 40
  Box2 5, 4, 20, 37
  Box2 8, 8, 17, 34
  Box2 11, 11, 14, 31
  Center 5, " "
  Center 17, " "
  Center 11, " "
  COLOR 15, 2: Center 23, ""
 
END SUB

DEFINT A-Z
SUB Siren (Hi%, Range%)
  
  FOR Count = Range TO -Range STEP -4
    SOUND Hi - ABS(Count), .3
    Count = Count - 2 / Range
  NEXT Count

END SUB

DEFINT A-Z
FUNCTION Slump (Min, max, Ej)

DO
  DO
    Sl = INT(RND * 100)
  LOOP UNTIL Sl >= Min AND Sl <= max
LOOP WHILE Sl = Ej

Slump = Sl

END FUNCTION