DECLARE SUB Help (AktBana%)
'DITJUV10.BAS

ON ERROR GOTO Fel
CLS
DEFINT A-Z
DIM Namn$(1 TO 10), P&(1 TO 10), Plats(1 TO 5), Fel200$(0 TO 7)
DIM Bild&(1 TO 6400)

    SCREEN 1: CLS
    GOTO KonfigStart

Stars:
    LOCATE 6, 7: PRINT "D I A M A N T T J U V A R"
    LOCATE 9, 12: PRINT "I  F A R T E N"
    LOCATE 12, 12: PRINT "v 1.0 Monokrom"
    LOCATE 16, 6: PRINT "David Eriksson Public Domain"
    LOCATE 21, 7: PRINT "Tryck p† B f”r att b”rja"
    LOCATE 23, 4: PRINT "Tryck p† H f”r hj„lpinformation"
   
    'E$ = "*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *"
    WHILE INKEY$ <> "": WEND
    WHILE Ink$ = ""
    '    FOR a = 1 TO 5
    '        LOCATE 1, 1
    '        PRINT MID$(E$, a, 40);
    '        LOCATE 22, 1
    '        PRINT MID$(E$, 6 - a, 40);
    '        FOR b = 2 TO 21
    '            c = (a + b) MOD 5
    '            IF c = 1 THEN
    '            LOCATE b, 40
    '                PRINT "*";      'CHR$(14);
    '                LOCATE 23 - b, 1
    '                PRINT "*";      'CHR$(14)
    '            ELSE
    '                LOCATE b, 40
    '                PRINT " ";
    '                LOCATE 23 - b, 1
    '                PRINT " ";
    '            END IF
    '       NEXT b
    '    NEXT a
        Ink$ = INKEY$
    WEND
    RETURN
          
KonfigStart:
        GOSUB Stars
        SELECT CASE Ink$
            CASE "B", "b"
            CASE "H", "h"
                Help (-1): Ink$ = "": GOTO KonfigStart
            CASE CHR$(27)
                SCREEN 2: SCREEN 0: CLS : END
            CASE ELSE: Ink$ = "": GOTO KonfigStart
        END SELECT
        CLS
        'PRINT : PRINT "Ange slumptalsgrad": INPUT "(-32768 till 32767): ", Grad&
Tid:     
        PRINT : PRINT "Ange tid": INPUT "(30 till 300 sekunder): ", Tid
        IF Tid < 30 OR Tid > 300 THEN GOTO Tid
        'Tid = 130
        PRINT : PRINT "Tryck p† Escape f”r att sluta mitt"
        PRINT "i ett spel"
        'PRINT : PRINT "Tryck p† P f”r att ta en paus"
        PRINT : PRINT "Tryck p† valfri tangent f”r att b”rja"
        WHILE INKEY$ = "": WEND
        'Grad& = 2341
        Grad& = Grad& + TIMER / 3: IF Grad& > 32767 THEN Grad& = Grad& - (TIMER / 3)
        RANDOMIZE Grad&
      
Start:
        SCREEN 1: CLS : DIM Teck$(1 TO 10)
        Teck$(1) = CHR$(219) + CHR$(219): Teck$(2) = STRING$(40, 219)
        Teck$(3) = "*": Teck$(4) = "œ": Teck$(5) = CHR$(27): Teck$(6) = " "
        Teck$(7) = CHR$(25)

BanVal:     
        CLS
        SELECT CASE Bana:
                CASE 0: GOSUB Bana0
                CASE 1: GOTO Bana1      'Bana = 0: GOTO BanVal
                CASE 2: Bana = 0: GOTO BanVal
        END SELECT
        GOTO InKnapp

Bana0:
        PRINT
        FOR a = 1 TO 7
                PRINT Teck$(1); SPC(36); Teck$(1)
                PRINT Teck$(1); SPC(36); Teck$(1)
                PRINT Teck$(2)
        NEXT a
        LOCATE 21, 1: PRINT " "; Teck$(5)

        c = 3: Rad = 2: st = INT(RND * 2 + 1): nr = 18: GOSUB Slump
        c = 3: Rad = 2: st = INT(RND * 4 + 1): nr = 15: GOSUB Slump
        c = 3: Rad = 3: st = INT(RND * 6) + 1: nr = 5: GOSUB Slump
        c = 6: Rad = 4: st = 1: nr = 26: GOSUB Slump
        c = 3: Rad = 5: st = INT(RND * 3 + 1): nr = 22: GOSUB Slump
        c = 3: Rad = 6: st = INT(RND * 3 + 1): nr = 1: GOSUB Slump
        c = 3: Rad = 6: st = INT(RND * 4 + 1): nr = 20: GOSUB Slump
        c = 6: Rad = 7: st = 1: nr = 35: GOSUB Slump
        c = 3: Rad = 8: st = INT(RND * 8 + 1): nr = 19: GOSUB Slump
        c = 3: Rad = 9: st = INT(RND * 2 + 1): nr = 35: GOSUB Slump
        c = 6: Rad = 10: st = 1: nr = 8: GOSUB Slump
        c = 3: Rad = 11: st = INT(RND * 2 + 1): nr = 10: GOSUB Slump
        c = 3: Rad = 12: st = INT(RND * 3 + 1): nr = 5: GOSUB Slump
        c = 6: Rad = 13: st = 1: nr = 25: GOSUB Slump
        c = 3: Rad = 14: st = INT(RND * 7 + 1): nr = 18: GOSUB Slump
        c = 6: Rad = 16: st = 1: nr = 10: GOSUB Slump
        c = 3: Rad = 17: st = INT(RND * 5 + 1): nr = 10: GOSUB Slump
        c = 3: Rad = 18: st = INT(RND * 5 + 1): nr = 28: GOSUB Slump
        c = 6: Rad = 19: st = 1: nr = 1: GOSUB Slump
        c = 3: Rad = 20: st = 1: nr = 35: GOSUB Slump
        c = 3: Rad = 20: st = INT(RND * 4 + 1): nr = 20: GOSUB Slump
        c = 3: Rad = 21: st = 1: nr = 35: GOSUB Slump
        c = 3: Rad = 21: st = INT(RND * 3 + 1): nr = 5: GOSUB Slump
        c = 4: Rad = 3: st = 1: nr = 15: GOSUB Slump
        NuSek& = TIMER
        WHILE INKEY$ <> "": WEND
        RETURN

InKnapp:   
        sek& = TIMER
        LOCATE 1, 2: PRINT "Tid:"; sek& - NuSek&; "av"; Tid
        IF sek& - NuSek& >= Tid THEN
                LOCATE 1, 1: PRINT STRING$(40, 32)
                LOCATE 1, 1: PRINT "Larmet g†r . . ."
                FOR j = 1 TO 10: BEEP: NEXT j
                LOCATE 1, 1: PRINT STRING$(40, 32)
                LOCATE 1, 1: PRINT "Spelet „r slut . . ."
                FOR h = 1 TO 10: BEEP: NEXT h
                LOCATE 1, 1: PRINT STRING$(40, 32)
                LOCATE 1, 1: PRINT "Bytet blev 0 kr . . ."
                FOR i = 1 TO 10: BEEP: NEXT i
                GOTO Fast
        END IF
        LOCATE 1, 20: PRINT "Diamanter: "; P&
        Ink$ = INKEY$
        IF Ink$ = "" THEN GOTO InKnapp
        LOCATE Rad, Teck: PRINT " "
       
        IF Bana = 0 THEN
            'LOCATE rad, teck: PRINT " "
            SELECT CASE Ink$
                'CASE CHR$(0) + ";": Help (Bana)
                CASE CHR$(0) + "K", "Z", "z": IF NOT SCREEN(Rad, Teck - 1) = 219 THEN Teck = Teck - 1
                CASE CHR$(0) + "M", "X", "x": IF NOT SCREEN(Rad, Teck + 1) = 219 THEN Teck = Teck + 1
                CASE " ": GOSUB Hopp
                CASE CHR$(27): GOTO Klar
                CASE ELSE: Ink$ = "": GOTO InKnapp
            END SELECT
        IF SCREEN(Rad, Teck) = 27 THEN Bana = 1: GOTO BanVal
        IF SCREEN(Rad, Teck) = ASC("*") THEN P& = P& + 1
        IF SCREEN(Rad + 1, Teck) = 32 THEN
            'LOCATE Rad, Teck: PRINT " ":
            Rad = Rad + 3
            IF SCREEN(Rad - 1, Teck) = ASC("*") THEN P& = P& + 1: LOCATE Rad - 1, Teck: PRINT " "
            IF SCREEN(Rad, Teck) = ASC("*") THEN P& = P& + 1
        END IF
    END IF
   
    IF Bana = 1 THEN
        'LOCATE rad, teck: PRINT CHR$(219)
        SELECT CASE Ink$
            CASE CHR$(0) + "K", "Z", "z": IF NOT SCREEN(Rad, Teck - 1) = 219 THEN Teck = Teck - 1
            CASE CHR$(0) + "M", "X", "x": IF NOT SCREEN(Rad, Teck + 1) = 219 THEN Teck = Teck + 1
            CASE CHR$(0) + "H", "P", "p": IF NOT SCREEN(Rad - 1, Teck) = 219 THEN Rad = Rad - 1
            CASE CHR$(0) + "P", "L", "l": IF NOT SCREEN(Rad + 1, Teck) = 219 THEN Rad = Rad + 1
            CASE CHR$(27): GOTO Klar
            CASE ELSE: Ink$ = "": BEEP: GOTO InKnapp
        END SELECT
        IF SCREEN(Rad, Teck) = ASC("*") THEN P& = P& + 1
        IF SCREEN(Rad, Teck) = ASC(Teck$(7)) THEN GOTO Klar
        IF SCREEN(Rad, Teck - 1) = 219 AND SCREEN(Rad, Teck + 1) = 219 THEN LOCATE Rad, Teck: PRINT CHR$(219)
        IF Teck = Plats(1) AND Rad = 10 THEN LOCATE Rad + 1, Teck: PRINT CHR$(219)
        IF Teck = Plats(2) AND Rad = 18 THEN LOCATE Rad - 1, Teck: PRINT CHR$(219)
        IF Teck = Plats(3) AND Rad = 4 THEN LOCATE Rad + 1, Teck: PRINT CHR$(219)
    END IF
    LOCATE Rad, Teck: PRINT "œ"
    GOTO InKnapp

Hopp:
        IF SCREEN(Rad - 1, Teck) = ASC("*") THEN P& = P& + 1
        LOCATE Rad - 1, Teck: PRINT Teck$(4)
        LOCATE Rad, Teck: PRINT Teck$(4)
        LOCATE Rad - 1, Teck: PRINT " "
        RETURN

Slump:  FOR D = 1 TO st
        P = 0
Svar:           P = P + 1
                'Ink$ = INKEY$
                'IF NOT Ink$ = "" AND nr < 30 THEN v = v + 1 + p - 5
                'IF NOT Ink$ = "" AND nr > 3 THEN v = v + 1 + p - 5
                IF P > 20 THEN st = st - D: GOTO Slump
                diam = ABS(INT(RND(RND) * 10 + nr + D + v))
                IF diam > 38 OR diam < 3 THEN GOTO Svar
                IF c = 4 THEN
                        FOR Z = 0 TO 2
                                IF SCREEN(Rad - Z, diam) = ASC("*") THEN GOTO Svar
                        NEXT Z
                END IF
                IF SCREEN(Rad, diam) = ASC("*") THEN GOTO Svar
                IF c = 3 AND SCREEN(Rad, diam) = 219 THEN GOTO Svar
                LOCATE Rad, diam: PRINT Teck$(c)
                IF c = 4 THEN Teck = diam
        NEXT D
        RETURN

Klar:                          
        CLS
        Byte& = P& * 1000
        PRINT "Bytet blev"; Byte&; "kr"
        IF Tid > 130 AND sek& - NuSek& < 130 THEN Tid2 = 130 ELSE Tid2 = 300
        IF Tid <= 130 OR Tid2 <= 130 THEN
                TidByte& = ABS(sek& - NuSek& - 130): TidByte& = TidByte& * 100
                Byte& = Byte& + TidByte&
                PRINT "Du f†r ocks† "; TidByte&; "kr f”r "
                PRINT "den tid ("; ABS(sek& - NuSek& - 130); "sek) du hade kvar till 130"
        END IF
        IF P& > 70 THEN
                PRINT "+ en bonus p† 10 000 f”r att"
                PRINT "du tog fler „n 70 diamanter"
                Byte& = Byte& + 10000
        END IF
        PRINT "Summan „r"; Byte&; "kr. Grattis!"
        PRINT : PRINT "Tio - i - topp:"
        GOSUB Topp
        PRINT : PRINT "Vill du k”ra igen? (J/N)"

ValKnapp:
        Ink$ = INKEY$
        SELECT CASE Ink$
                CASE "J", "j":
                        Bana = 0
                        P& = 0
                        Byte& = 0
                        GOTO BanVal
                CASE "N", "n": SCREEN 2: SCREEN 0: END
                CASE ELSE: GOTO ValKnapp
        END SELECT
        END

Topp:
        PRINT SPC(6); "Namn:"; SPC(17); "Po„ng:"
        OPEN "DIAMANT.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$)
                IF E = 10 THEN PRINT E; ". "; Namn$(E); " "; P&(E) ELSE PRINT " "; E; ". "; Namn$(E); " "; P&(E)
        NEXT E
        FOR f = 1 TO 10
                IF Byte& >= P&(f) THEN
                        PRINT : 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
                        RETURN
                END IF
        NEXT f
        CLOSE
        RETURN

Fast:
        LOCATE Rad, Teck - 1: PRINT "!"
        LOCATE Rad, Teck + 1: PRINT "!"
        LOCATE 1, 1: PRINT STRING$(40, 32)
        LOCATE 1, 1: PRINT "Fast . . ."
        FOR k = 1 TO 10: BEEP: NEXT k
        LOCATE 1, 1: PRINT STRING$(40, 32)
        LOCATE 1, 1: PRINT "Vill du k”ra igen? (J/N)"
FastVal:       
        Ink$ = INKEY$: IF Ink$ = "" THEN GOTO FastVal
        SELECT CASE Ink$
            CASE "J", "j": Bana = 0: P& = 0: Byte& = 0: GOTO BanVal
            CASE "N", "n": SCREEN 2: SCREEN 0: END
            CASE ELSE: Ink$ = "": GOTO FastVal
        END SELECT

Bana1:
        CLS
        SCREEN 1
        PRINT
        LOCATE 2, 1: PRINT STRING$(40, 219)
        FOR a = 3 TO 22
                LOCATE a, 1: PRINT STRING$(1, 219)
                LOCATE a, 40: PRINT STRING$(1, 219)
        NEXT a
        LOCATE 23, 1: PRINT STRING$(40, 219)
       
        LOCATE 5, 4: PRINT STRING$(34, 219)
        FOR n = 6 TO 20: LOCATE n, 4: PRINT CHR$(219); SPC(32); CHR$(219): NEXT n
        FOR o = 8 TO 17: LOCATE o, 8: PRINT CHR$(219); SPC(24); CHR$(219): NEXT o
        LOCATE 8, 9: PRINT STRING$(24, 219)
        LOCATE 11, 12: PRINT STRING$(18, 219)
        FOR P = 12 TO 13
                LOCATE P, 12: PRINT CHR$(219); SPC(16); CHR$(219)
        NEXT P
        LOCATE 14, 12: PRINT STRING$(18, 219)
        LOCATE 17, 9: PRINT STRING$(24, 219)
        LOCATE 20, 5: PRINT STRING$(32, 219)

       
    c = 3: Rad = 3: st = INT(RND * 3 + 1): nr = 20: GOSUB Slump
    c = 3: Rad = 4: st = INT(RND * 5 + 1): nr = 5: GOSUB Slump
    c = 3: Rad = 6: st = INT(RND * 2 + 2): nr = INT(RND): GOSUB Slump
    c = 3: Rad = 7: st = INT(RND * 7 + 1): nr = INT(RND + 10): GOSUB Slump
    c = 3: Rad = 8: st = INT(RND * 2 + 1): nr = 1: GOSUB Slump
    c = 3: Rad = 8: st = INT(RND * 2 + 2): nr = 30: GOSUB Slump
    c = 3: Rad = 10: st = INT(RND * 3 + 3): nr = 20: GOSUB Slump
    c = 3: Rad = 12: st = 3: nr = 3: GOSUB Slump
    c = 3: Rad = 12: st = 4: nr = 30: v = -1: GOSUB Slump
    c = 3: Rad = 14: st = 4: nr = 1: GOSUB Slump
    c = 3: Rad = 15: st = 4: nr = 15: GOSUB Slump
    c = 3: Rad = 17: st = INT(RND * 3 + 1): nr = 25: GOSUB Slump
    c = 3: Rad = 18: st = INT(RND * 3 + 2): nr = 15: v = -1: GOSUB Slump
    c = 3: Rad = 22: st = INT(RND * 4 + 2): nr = 15: v = 2: GOSUB Slump
    c = 6: Rad = 11: st = 1: nr = 13: GOSUB Slump: Plats(1) = diam
    c = 6: Rad = 17: st = 1: nr = 9: GOSUB Slump: Plats(2) = diam
    c = 7: Rad = 23: st = 1: nr = 5: GOSUB Slump
    c = 6: Rad = 5: st = 1: nr = 10: GOSUB Slump: Plats(3) = diam
   
RitaTjuv:  
    c = 4: Rad = 13: st = 1: nr = 20
    diam = ABS(INT(RND(RND) * 10 + nr + D + v))
    IF diam < 11 OR diam > 27 THEN GOTO RitaTjuv
    LOCATE 13, diam: PRINT "œ"
    Rad = 13: Teck = diam
    WHILE INKEY$ <> "": WEND
    GOTO InKnapp

Fel:
    Felet = ERR
    Fel200$(0) = "FEL 200 !"
    Fel200$(1) = "Hj„lpfel; angiven bana etc. i SUB Help finns ej"
    Fel200$(2) = "Om detta program „r kompilerat kontakta:"
    Fel200$(3) = "David Eriksson"
    Fel200$(4) = "Alk„rrsgatan 9"
    Fel200$(5) = "603 64 NORRK™PING"
    Fel200$(6) = CHR$(13)
    Fel200$(7) = "Skriv tydligt att fel 200 har uppst†tt"
    SELECT CASE Felet
        CASE 200
            BEEP: CLS
            FOR FelVarv = 0 TO 7: PRINT Fel200$(FelVarv): NEXT FelVarv
            GOSUB FelInfo
IfSvaret:          
            IF Svaret$ = "J" THEN
                FOR FelVarv = 0 TO 7: LPRINT Fel200$(FelVarv): NEXT FelVarv
            ELSE
                IF Svaret$ <> "N" THEN GOSUB FelInfo: GOTO IfSvaret
            END IF
        CASE ELSE
            ON ERROR GOTO 0
            ON ERROR GOTO Fel
            END
    END SELECT
    END

FelInfo:
    INPUT "Skriva ut info p† skrivare? (J/N) ", Svar$
    SELECT CASE UCASE$(Svar$)
        CASE "J"
            Svaret$ = "J": RETURN
        CASE "N"
            Svaret$ = "N": RETURN
        CASE ELSE: GOTO FelInfo
    END SELECT
    RETURN

Slut:
    SCREEN 2
    SCREEN 0
    END

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

    SELECT CASE AktHelp
        CASE 0: GOSUB StartHelp
        CASE ELSE: ERROR 200
    END SELECT
    EXIT SUB

StartHelp:
    CLS
    PRINT "Bana 1: V†ningarna (Fr†n sidan)"
    PRINT "G† med h”ger- och v„nsterpilarna. Hoppa"
    PRINT "med mellanslag."
    PRINT "Bana 2: Labyrinten (Uppifr†n)"
    PRINT "G† med alla piltangenter. H„r hoppar du"
    PRINT "inte."
    PRINT STRING$(40, ASC("-"))
    PRINT "Ta s† m†nga diamanter som m”jligt p†"
    PRINT "vald tid."
    PRINT "Tips: v„lj 300 sek. fr†n b”rjan s† ser"
    PRINT "du vad kan."
    PRINT "Med Escape avslutar du inne i ett spel."
    PRINT : PRINT "Tryck p† valfri tangent f”r att g† till"
    PRINT "meny."
    PRINT : PRINT
    PRINT "Programmerare: David Eriksson"
    PRINT "               Alk„rrsgatan 9"
    PRINT "               603 64 NORRK™PING"
    PRINT : PRINT "Skicka g„rna ett kort!"
    WHILE INKEY$ = "": WEND
    CLS
    RETURN

END SUB