' Jawbreaker Clone - German - paul@lenz-online.de

$OPTION ICON "Jawbreak.ico"

fi$ = "jb.txt"

DECLARE SUB Paint
DECLARE SUB Repaint
DECLARE SUB Click (Button, mx, my, shift)
DECLARE SUB mark (x as integer, y as integer, c as integer)
DECLARE SUB back
DECLARE SUB ZInfo
DECLARE SUB Nichts

DIM Timer1 AS QTIMER
Timer1.OnTimer = Paint
Timer1.Interval = 10
Timer1.Enabled = 1

DIM Arial AS QFONT
Arial.Name = "arial"
Arial.AddStyles = 0
Arial.Size = 11

DIM Registry AS QRegistry 
Registry.OpenKey("Software\LenzSoft\Jawbreaker", 0)
if Registry.ValueExists("Gesamtsumme") then gesumm = Registry.ReadInteger("Gesamtsumme")
if Registry.ValueExists("Anzahl")      then anzahl = Registry.ReadInteger("Anzahl")
if Registry.ValueExists("Highscore")   then highsc = Registry.ReadInteger("Highscore")
if Registry.ValueExists("FormTop")     then ft     = Registry.ReadInteger("FormTop")
if Registry.ValueExists("FormLeft")    then fl     = Registry.ReadInteger("FormLeft")
Registry.CloseKey

if fl = 0 then fl = int((screen.width - 365) / 2)
if ft = 0 then ft = int((screen.height - 457) / 2)

dim jb(10,11) as integer, cp(10,11) as integer, cnt(5) as integer, farb(5) as integer

randomize timer
for x = 0 to 10
    for y = 0 to 11
        jb(x, y) = rnd(5) + 1
        cnt(jb(x,y)) = cnt(jb(x,y)) + 1
    next
next

rot   = &H3333FF
gruen = &H00BB00
blau  = &HFF7777
gelb  = &H00E7FF
lila  = &HFF00FF
weiss = &HFFFFFF
grau  = &HAAAAAA
schwarz = 0
farb(1) = rot
farb(2) = gruen
farb(3) = blau
farb(4) = gelb
farb(5) = lila

r = 30
asum = 0
status$ = "neu"
vs = 0

CREATE form as QFORM
Top = ft
Left = fl
Width = 11 * r + 35
Height = 12 * r + 97
Caption = "Jawbreaker"
BorderStyle = 3
Icon = "Jawbreak.ico"
OnPaint = Repaint
CREATE IPanel AS QPANEL
    Left = 10
    Top = 10
    Width = 122
    Height = 33
    BevelOuter = 1
    CREATE Info AS QCANVAS
        Left = 1
        Top = 1
        Width = 119
        Height = 31
        Font = Arial
    END CREATE
END CREATE
CREATE Summe AS QPANEL
    Left = 142
    Top = 10
    Width = 118
    Height = 33
    Font = Arial
    Caption = "0 Punkte"
    BevelOuter = 1
END CREATE
CREATE Zuruck AS QBUTTON
    Top = 10
    Left = 270
    Width = 78
    Height = 34
    Font = Arial
    Caption = "zurück"
    OnClick = back
    Enabled = 0
END CREATE
CREATE Panel AS QPANEL
    Left = 10
    Top = 52
    Width = 11 * r + 8
    Height = 12 * r + 8
    BevelWidth = 2
    BevelInner = 1
    CREATE Canvas AS QCANVAS
        Left = 4
        Top = 4
        Width = 11 * r
        Height = 12 * r
        OnMouseDown = Click
        Font = Arial
    END CREATE
END CREATE
showmodal
END CREATE


SUB Repaint
    Timer1.Enabled = 1
END SUB

SUB Paint
    Timer1.Enabled = 0
    Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height, weiss)
    if status$ = "fertig" then 
        Timer1.OnTimer = Nichts
        c = 0
        for x = 0 to 10
            for y = 0 to 11
                if jb(x,y) > 0 then c = c + 1
            next
        next
        if c < 5 then bb = (5 - c) * 20
        su = val(Summe.Caption) + bb
        if su > highsc then 
            Canvas.Textout 50, 50, "Neuer Höchststand!" , rot, weiss
            highsc = su
        end if
        anzahl = anzahl + 1
        gesumm = gesumm + su
        d$ = "Jawbreaker-Clone by Paul Lenz  6.8.2004"
        d = (Canvas.Width - Canvas.TextWidth(d$)) / 2
        Canvas.Textout d, 020, d$, blau, weiss
        Canvas.Textout 50, 080, "Breaker-Bonus:" , schwarz, weiss
        Canvas.Textout 50, 100, "Dieses Spiel:" , schwarz, weiss
        Canvas.Textout 50, 120, "Anzahl Spiele:" , schwarz, weiss
        Canvas.Textout 50, 140, "Höchststand:" , schwarz, weiss
        Canvas.Textout 50, 160, "Durchschnitt:" , schwarz, weiss
        d$ = str$(bb) : d = 200 - Canvas.TextWidth(d$)
        Canvas.Textout d , 080, d$ , schwarz, weiss
        d$ = str$(su) : d = 200 - Canvas.TextWidth(d$)
        Canvas.Textout d , 100, d$ , schwarz, weiss
        d$ = str$(anzahl) : d = 200 - Canvas.TextWidth(d$)
        Canvas.Textout d , 120, d$ , schwarz, weiss
        d$ = str$(highsc) : d = 200 - Canvas.TextWidth(d$)
        Canvas.Textout d , 140, d$ , schwarz, weiss
        d$ = str$(int(gesumm / anzahl + .5)) : d = 200 - Canvas.TextWidth(d$)
        Canvas.Textout d , 160, d$ , schwarz, weiss
        Registry.OpenKey("Software\LenzSoft\Jawbreaker", 1)
        Registry.WriteInteger("Gesamtsumme", gesumm)
        Registry.WriteInteger("Anzahl", anzahl)
        Registry.WriteInteger("Highscore", highsc)
        Registry.WriteInteger("FormTop", Form.Top)
        Registry.WriteInteger("FormLeft", Form.Left)
        Registry.CloseKey
        Info.FillRect 0, 0, 119, 31, weiss
        Info.TextOut 37, 6, "Fertig!", rot, -1
        status$ = "ende"
        exit sub
    end if
    if status$ = "neu" then
        Info.FillRect 0, 0, 119, 31, schwarz
        Info.TextOut 3, 0, "Anzahl Breaker", weiss, -1
        c = -16
        for x = 60 to 1 step - 1
            for y = 1 to 5
                if cnt(y) = x then 
                    c = c + 22
                    Info.TextOut c, 14, str$(cnt(y)), farb(y), -1
                end if
            next
        next
    else
        ZInfo
    end if

    for x = 0 to 10
        for y = 0 to 11
            if jb(x,y) > 0 then
                c = jb(x,y)
                if jb(x,y) > 10 then c = c - 10
                Canvas.Circle x*r+2, y*r+2, (x+1)*r-1, (y+1)*r-1, schwarz, farb(c)
            end if
        next
    next
END SUB


SUB ZInfo
    Info.FillRect 0, 0, 119, 31, &HD8D8D8
    p = (119 - Info.TextWidth(str$(vs))) / 2
    if vs > 0 then Info.TextOut p, 6, str$(vs), schwarz, -1
END SUB


SUB mark(x, y, c)
    dim mx as integer, my as integer
    if jb(x,y) > 10 then exit sub
    if jb(x,y) <> c then exit sub
    Canvas.FillRect x*r,   y*r,   (x+1)*r,   (y+1)*r,   grau
    Canvas.Circle   x*r+2, y*r+2, (x+1)*r-1, (y+1)*r-1, schwarz, farb(jb(x,y))
    jb(x,y) = jb(x,y) + 10
    mx = x
    my = y
    x = mx + 1 : y = my : if x <= 10 then mark(x, y, c)
    x = mx - 1 : y = my : if x >=  0 then mark(x, y, c)
    x = mx : y = my + 1 : if y <= 11 then mark(x, y, c)
    x = mx : y = my - 1 : if y >=  0 then mark(x, y, c)
END SUB


SUB Nichts
END SUB


SUB back
    if Zuruck.Caption = "Neu" then run "jawbreak.exe" : end
    for x = 0 to 10
        for y = 0 to 11
            jb(x,y) = cp(x,y)
        next
    next
    Summe.Caption = str$(asum) + " Punkte"
    Zuruck.Enabled = 0
    vs = 0
    ZInfo
    status$ = "next"
    Timer1.OnTimer = Paint
    Repaint
END SUB


SUB Click(Button, mx, my, shift)
    x = int(mx / r)
    y = int(my / r)
    c = jb(x,y)

    if status$ = "neu" or status$ = "next" then
        ' markieren
        if jb(x,y) = 0 then exit sub
        ok = 0
        if x >  0 then if jb(x-1,y) = c then ok = 1
        if x < 10 then if jb(x+1,y) = c then ok = 1
        if y >  0 then if jb(x,y-1) = c then ok = 1
        if y < 11 then if jb(x,y+1) = c then ok = 1
        if ok = 0 then exit sub    
        status$ = "vorschau"
        Timer1.OnTimer = Nichts
        mark(x, y, c)
        c = 0
        for x = 0 to 10
            for y = 0 to 11
                if jb(x, y) > 10 then c = c + 1
            next
        next
        vs = c * (c - 1)
        ZInfo
    else
        Timer1.OnTimer = Paint
        status$ = "next"
        if jb(x,y) < 10 then
            ' Markierung entfernen
            for x = 0 to 10
                for y = 0 to 11
                    if jb(x, y) > 10 then jb(x, y) = jb(x, y) - 10
                next
            next
            vs = 0
            ZInfo
        else
            ' platzen lassen
            for x = 0 to 10
                for y = 0 to 11
                    cp(x,y) = jb(x,y)
                    if jb(x, y) > 10 then 
                        cp(x,y) = jb(x,y) - 10
                        for z = y to 1 step - 1
                            jb(x, z) = jb(x, z - 1)
                        next
                        jb(x, 0) = 0
                    end if
                next
                if jb(x,11) = 0 then
                    for z = x to 1 step - 1
                        for y = 0 to 11
                            jb(z,y) = jb(z-1,y)
                        next
                    next
                    for y = 0 to 11 : jb(0,y) = 0: next
                end if
            next
            paint
            ' Ende checken
            ok = 0
            for x = 0 to 10
                for y = 0 to 11
                    c = jb(x,y)
                    if c > 0 then
                        if x >  0 then if jb(x-1,y) = c then ok = 1
                        if x < 10 then if jb(x+1,y) = c then ok = 1
                        if y >  0 then if jb(x,y-1) = c then ok = 1
                        if y < 11 then if jb(x,y+1) = c then ok = 1
                        if ok > 0 then x = 10 : y = 11
                    end if
                next
            next
            asum = val(Summe.Caption)
            Summe.Caption = str$(val(Summe.Caption) + vs) + " Punkte"
            Zuruck.Enabled = 1
            vs = 0
            ZInfo
        end if
        if ok = 0 then 
            Zuruck.Caption = "Neu"
            status$ = "fertig"
        end if
        Repaint
    end if
END SUB