XProfan

!
Test
----
declare mx%,my%       Mausposition
declare fx%,fy%       Figurposition
declare px%,py%       neue Müllposition
declare dx%,dy%       Abstände
declare i%,j%         Zählvariablen
declare anz%,vorg%    Anzahl gesammelt/Vorgabe
declare ende%,ok%     Endeschalter, Zug-Ok-Schalter
declare ton%          Sound-Flag
declare scan%         Tastencode
declare tflag%        transparentes Icon?
declare rotx%, roty%  Rotation X/Z-Achse
declare zoom%         Entfernung
declare f$,figur$
dim$ 12

PROC DrawGLScene

    declare y%, x%, f$
    oGL("Clear")
    oGL("Origin", 0, 0, zoom%)
    oGL("Rotate", rotx%, roty%, 0)
    oGL("COLOR", 0.3, 1, 0.3, 1)
    oGL("Cuboid", 12, 0.1, 10)
    y%=12
    x%=14
    oGL("Move",7.5, 0.1, 5.5)

    while y%

        while x%

            oGL("Move",-1,0,0)
            f$ = mid$(list$(y%),x%,1)

            if (fx% = x%) and (fy% = y%)

                oGL("COLOR", 1, 1, 0, 1)
                oGL("Cuboid", 0.7, 1.2, 0.7)

            elseif f$ = "B"

                oGL("COLOR", 0, 0.7, 0, .5)
                oGL("Pyramid", 0.7, 1.6, 0.7)

            elseif f$ = "S"

                oGL("COLOR", 0.3, 0.3, 0.3, 1)
                oGL("Cuboid", 0.8, 0.4, 0.8)

            elseif f$ = "E"

                oGL("COLOR", 0, 0, 1, 1)
                oGL("Cuboid", 1, 0.1, 1)

            elseif f$ = "M"

                oGL("COLOR", 1, 0, 0, 1)
                oGL("Cuboid", 0.5, 0.5, 0.5)

            endif

            dec x%

        endwhile

        oGL("Move",14,0,-1)
        let x%=14
        dec y%

    endwhile

    oGL("Show")

ENDPROC

PROC SPIELFELD

    case ton% : playsound "toccata.wav", 1
    list$  1="SSSSSSSSSSSSSS"
    list$  2="SBBBBBBBBBBBBS"
    list$  3="SBB   BB  GBBS"
    list$  4="SBB M BB  MBBS"
    list$  5="SBSS  BB    BS"
    list$  6="SBB BBBBSSSSBS"
    list$  7="SB     S    BS"
    list$  8="SB S   S S  BS"
    list$  9="SB SBM S BBBBS"
    list$ 10="SB BB  S   EBS"
    list$ 11="SBBBBBBBBBBBBS"
    list$ 12="SSSSSSSSSSSSSS"
    let i%=12
    let j%=14
    cls
    usecursor 2
    let vorg%=0
    let anz% =0

    while i%

        while j%

            f$ = mid$(list$(i%),j%,1)

            if f$ = "M"

                inc vorg%

            elseif f$ = "G"

                fx%=j%
                fy%=i%

            endif

            dec j%

        endwhile

        let j%=14
        dec i%

    endwhile

    useicon "GESICHT"
    usecursor 0

ENDPROC

PROC TON

    ton% = 1 - ton%

    if ton%

        checkmenu 190,1

    else

        checkmenu 190,0

    endif

ENDPROC

PROC SPIEL

    ok% = 1
    dx% = mx% - fx%
    dy% = my% - fy%
    px% = dx% + mx%
    py% = dy% + my%
    f$ = mid$(list$(my%),mx%,1)
    case instr(f$,"BE") : ok% = 0

    if f$ = "S"

        case instr(mid$(list$(py%),px%,1),"BMES") : ok%=0

        if ok%

            case ton% : playsound "pop.wav",1
            list$ py% = del$(list$(py%),px%,1)
            list$ py% = ins$("S",list$(py%),px%)
            list$ my% = del$(list$(my%),mx%,1)
            list$ my% = ins$(" ",list$(my%),mx%)

        endif

    endif

    if instr(f$,"M")

        case instr(mid$(list$(py%),px%,1),"BSE") : ok%=0

        if ok%

            case ton% : playsound "bloop.wav",1
            list$ py% = del$(list$(py%),px%,1)
            list$ py% = ins$("M",list$(py%),px%)
            list$ my% = del$(list$(my%),mx%,1)
            list$ my% = ins$(" ",list$(my%),mx%)

        endif

        if @instr(@mid$(@list$(py%),px%,1),"E")

            ok%=1
            anz%=@add(anz%,1)
            list$ my% = del$(list$(my%),mx%,1)
            list$ my% = ins$(" ",list$(my%),mx%)
            case ton% : playsound "laser.wav",0

        endif

    endif

    ifnot ok%

        case ton% : playsound "vault.wav",1
        return

    endif

    i%  = mx%
    mx% = fx%
    fx% = i%
    i%  = my%
    my% = fy%
    fy% = i%

    if anz% = vorg%

        whileloop 0, 72

            roty% = roty% + 5
            DrawGLScene()

        endwhile

        case ton% : playsound "applaus2.wav",1
        messagebox("Du hast es geschafft!","G E W O N N E N !",48)
        ende%=1

    endif

ENDPROC

PROC ENDE

    case messagebox("Willst Du wirklich aufhören?","SPIELENDE",36) = 6:ende% = 1

ENDPROC

PROC HILFE

    f$ = "DAS MÜLLSPIEL 3D
    "
    + "Ihre Aufgabe als Parkwächter (gelb) ist es, den Müll (rot) in den "
    + "bereitstehenden Mülleimer (blau) zu schieben. Der direkte Weg "
    + "wird leider durch Bäume und Steine versperrt. Während "
    + "die Bäume fest stehen, können die Steine verschoben werden."
    case messagebox(f$,"ANLEITUNG 1/3",65) = 2:return
    DrawGLScene()
    f$ = "Bewegung:
    "
    + "Sie können ein Feld waagrecht oder senkrecht laufen, "
    + "nicht aber diagonal. Steuern Sie den Parkwächter mit den "
    + "Cursortasten. Liegt in Laufrichtung Müll oder ein Stein, "
    + "so wird dieser weitergeschoben. "
    case messagebox(f$,"ANLEITUNG 2/3",65) = 2:return
    DrawGLScene()
    f$ = "Übrige Funktionen:
    "
    + "Über den Menüpunkt Ton können Sie den Sound an- und "
    + "ausschalten. Mit Ende können Sie das Spiel beenden.
    "
    + "Mit den Tasten Pos1/Ende/Bild+/Bild- ändern Sie das Blickfeld!
    "
    + "Das Spiel ist komplett in XProfan 10 geschrieben. "
    messagebox(f$,"ANLEITUNG 3/3",64)

ENDPROC

*** HAUPTPROGRAMM *****
windowtitle "DAS MÜLLSPIEL 3D"
CLS 0
popup "&Spiel"
appendmenu 180,"&Neues Spiel"
appendmenu 190,"&Ton	F2"
appendmenu 200,"&Ende	F3"
popup "&Hilfe"
appendmenu 210,"&Hilfe	F1"
appendmenu 220,"Über"
ton%=1
checkmenu 190,1
oGL("INIT", %HWnd, 0, 0, 0, 1)
set("autopaint", 0)
ende% = 0
roty% = 15
rotx% = 225
zoom% = -15
SPIELFELD

whileloop 0, 36

    rotx% = rotx% - 5
    DrawGLScene()

endwhile

whilenot ende%

    waitinput
    mx%=fx%
    my%=fy%

    if iskey(39)

        inc mx%
        spiel

    elseif iskey(37)

        dec mx%
        spiel

    elseif iskey(40)

        inc my%
        spiel

    elseif iskey(38)

        dec my%
        spiel

    elseif iskey(34)

        inc rotx%

    elseif iskey(33)

        dec rotx%

    elseif iskey(36)

        inc roty%

    elseif iskey(35)

        dec roty%

    elseif iskey(113)

        TON

    elseif iskey(114)

        ENDE

    elseif iskey(112)

        HILFE

    elseif %menuitem

        DrawGLScene()
        case menuitem(180) : SPIELFELD
        case menuitem(190) : TON
        case menuitem(200) : ENDE
        case menuitem(210) : HILFE

        if menuitem(220) or menuitem(254)

            playsound "fanfare.wav",1
            messagebox("© 1992-2006 Roland G. Hülsmann","DAS MÜLLSPIEL - OpenGL-DEMO",48)

        endif

        setmenuitem 0

    endif

    DrawGLScene()

endwhile

usecursor 0
end