'{$debug}
{$cleq}
'{$runtime xprfrun.small.exe}
'{$debug}

/* Tasten: 
        
        Pfeiltasten
        Strafe = A & D
        Blick = Bild
        
*/

declare ex%

declare terr.mem#,\
        terr.collidMem#

declare Tx.floor&,\
        Tx.wall&,\
        Tx.earth&,\
        Tx.sand&,\
        Tx.door&,\
        Tx.doorsteel&
        
declare obj.grid&,gd! // gridSizeMultiplier

declare yrot!,xpos!,zpos!,heading!,updw!,xp&,yp&

declare fpst&,\
        fps&,\
        fpsd!,\
        ofps&

declare terr.ypt&,\
        terr.oglList&,\
        terr.px&,\
        terr.xx&,\
        terr.yy&,\
        terr.CollidXx&,\
        terr.CollidYy&

decimals 10

def !piover180 0.0174532925

Set("autopaint", 0)

Windowstyle 1+2+8+16
Windowtitle "Oo"
Window 100,100 - 800,600

gd!:=1

Ogl("INIT", %hwnd, 0, 0, 0, 0)
oGL("BLENDMODE", 0)
'Ogl("FOG", 1.0, 1, 10*gd!)

Tx.floor&       =Ogl("LOADTEXTUREBMP", "tx.floor4.bmp", 3)
Tx.wall&        =Ogl("LOADTEXTUREBMP", "tx.wall2.bmp", 1)
Tx.earth&       =Ogl("LOADTEXTUREBMP", "tx.earth.bmp", 3)
Tx.sand&        =Ogl("LOADTEXTUREBMP", "tx.sand.bmp", 3)
Tx.door&        =Ogl("LOADTEXTUREBMP", "tx.door.bmp", 3)
Tx.doorsteel&   =Ogl("LOADTEXTUREBMP", "tx.doorsteel.bmp", 3)

OglCreateObjects

fpst&:=&gettickcount+1000
fpsd!:=1

declare x&,y&

whilenot ex%

        OglFrame
        AppFrame
        
        /* ViewMap?

        startpaint 0
        for y&:=0 to 9 do begin
        for x&:=0 to 9 do begin

                setpixel x&,y&,if(terr.getpx(x&,y&)==32,0,$00FFFFFF)
                
        end
        end
        
        setpixel xp&,yp&,$0000FF
        copysizedbmp 0,0 - 10,10 > 10,0 - 50,50;0
        endpaint
        
        */
                                 
wend

oGL("done")
terr.Dispose

end

proc AppFrame

         fps&+
         if &gettickcount>fpst&
         
                fps&:=fps&
                
                settext %hwnd,str$(fps&)+"fps"+" h:"+str$(heading!)+" x:"+str$(xpos!)+" z:"+str$(zpos!)+" yr:"+str$(yrot!)+" "+str$(terr.px&)+" x"+str$(xp&)+" y"+str$(yp&)
                
                ofps&:=fps&
                fpsd!:=80/fps&
                fps&:=0
                fpst&:=fpst&+1000
                
         endif

endproc

proc oglCam

        //da es in ogl keine cam gibt sondern blick immer von Position 0,0,0 gerendert wird,
        //bewegt und dreht man die Scene halt um den Punkt 0,0,0 herum, dass es so wirkt als
        //ob es eine Cam gibt, also muss die camfunktion auch vorm elementeerstellen passieren
        
        oGL("Rotate", updw!, 0, 0)                      //hochrunter neigung setzen
        oGl("Move",0,((-0.60*gd!)),-0.1)                //vom fussboden aufheben und bisl zurück den kopf
        oGL("Rotate", 0, 360 - yrot!, 0)                //blickrichtung setzen
        oGL("Move", -xpos!*gd!, 0, (-zpos!)*gd! )       //an position setzen
        
endproc

proc OglBg
endproc

proc OglTerrain

        ogl("DrawList",terr.oglList&)
        'ogl("DrawList",obj.grid&)
                
        //heaven
        
        /*
        ogl("move",0,(-100*gd!),(-10*gd!))
        Ogl("Color", 2,2, 3, 1)
        Ogl("Texture", Tx.sand&,1)
        ogl("rotate",0,sin(&gettickcount/3000)*6,0)
        ogl("sphere",(100*gd!),7,6)
        ogl("rotate",0,sin(&gettickcount/3000)*-6,0)
        ogl("move",0,(15*gd!),0)
        */
        
        //terrain
        
endproc

proc OglObjects


endproc


proc OglInput

        declare oxp&,oyp&,\
                oxpos!,ozpos!,oheading!,oyrot!,\
                oterr.px&,\
                wup%,wdw%,wleft%,wright%,wlstr%,wrstr%,wpgup%,wpgdw%,wesc%
                
        //tasten sichern
                
        wup%    =iskey(38)      //up forward
        wdw%    =iskey(40)      //dw backward
        wleft%  =iskey(37)      //left rotate left
        wright% =iskey(39)      //right rotate right
        wlstr%  =iskey(65)      //a strafe left 
        wrstr%  =iskey(68)      //d strafe right
        wpgup%  =iskey(33)      //pgup look up
        wpgdw%  =iskey(34)      //pgdw look down
        wesc%   =iskey(27)      //esc
        
        case wesc% : ex%:=1
                
        if wup%+wdw%+wlstr%+wrstr%      //wenn bewegung
        
                //die "guten alten" Werte

                oxpos!:=xpos!
                ozpos!:=zpos!
                oxp&:=xp&
                oyp&:=yp&

                // X-Achse reaktionen nach taste

                case wup%       : xpos! = xpos! - sin(heading! * !piover180) *  (0.05*fpsd!)
                case wdw%       : xpos! = xpos! + sin(heading! * !piover180) *  (0.05*fpsd!)
                case wlstr%     : xpos! = xpos! - sin((heading!+90) * !piover180) *  (0.02*fpsd!)
                case wrstr%     : xpos! = xpos! + sin((heading!+90) * !piover180) *  (0.02*fpsd!)
                                
                if CheckAxisCollid.X(0.52)
                
                        xpos!:=oxpos!
                        terr.px&:=oterr.px&
                        
                endif
                
                xp&:=int(-xpos!*5+0.52)+2

                // Y-Achse

                case wdw%       : zpos! = zpos! + cos(heading! * !piover180) *  (0.05*fpsd!)
                case wup%       : zpos! = zpos! - cos(heading! * !piover180) *  (0.05*fpsd!)
                case wrstr%     : zpos! = zpos! + cos((heading!+90) * !piover180) *  (0.02*fpsd!)
                case wlstr%     : zpos! = zpos! - cos((heading!+90) * !piover180) *  (0.02*fpsd!)

                if CheckAxisCollid.Y(0.52)
                
                        zpos!:=ozpos!
                        terr.px&:=oterr.px&
                        
                endif
                
                yp&:=int(-zpos!*5+0.52)+2
                
        endif
        
        // Blickwinkel
        
        if wright%
        
                heading! = heading! - (2*fpsd!)
                yrot! = heading!
        
        endif

        if wleft%

                heading! = heading! + (2*fpsd!)
                yrot! = heading!
        
        endif

        if wpgup%

                case updw!>-90 : updw!:=updw!-(fpsd!)
        
        endif
        
        if wpgdw%

                case updw!<90 : updw!:=updw!+(fpsd!)
        
        endif
        
        proc CheckAxisCollid.Y
        
                parameters syncy!
                
                declare k%
                
                k%:=0

                terr.px&:=terr.CollidGetPx(xp&,2+int(-zpos!*5+syncy!))

                if terr.px&==42

                        k%:=1

                endif

                return k%

        endproc
        
        proc CheckAxisCollid.X
        
                parameters syncx!
                
                declare k%

                k%:=0

                terr.px&:=terr.CollidGetPx(2+int(-xpos!*5+syncx!),yp&)
                
                if terr.px&==42
                        
                        k%:=1

                endif
                
                return k%
                
        endproc

endproc

proc OglFrame

        OglInput
        Ogl("Clear")
        Ogl("Origin",0,0,0)
        OglCam
        OglBg
        OglTerrain
        OglObjects
        Ogl("Show")

endproc

proc OglCreateObjects

        terr.Build
        
        //buildGrid
        obj.grid& = oGL("STARTLIST")
        /*
        Ogl("Color", 2, 2, 3, 2)
        Ogl("Texture", Tx.floor&,20)
        
        //floor
        Ogl("rotate",-90,0,0)
        Ogl("Quad",20,20)
        Ogl("rotate",90,0,0)
        
        //wall
        Ogl("Texture", Tx.wall&,1)
        Ogl("Move",0,0,-20)
        Ogl("Quad",20,5)
        Ogl("Move",0,0,20)
        Ogl("Quad",20,5)
        ogl("rotate",0,90,0)
        ogl("move",10,0,10)
        Ogl("Move",0,0,-20)
        Ogl("Quad",20,5)
        Ogl("Move",0,0,20)
        Ogl("Quad",20,5)
        */
        Ogl("EndList")
        
        xpos!:=-xp&/5
        zpos!:=-yp&/5
        heading!:=90
        yrot!:=90
                
endproc

proc ogl.createcube

        parameters x!,y!,z! , sx!,sy!,sz! , rx!,ry!,rz!
        
        ogl("push")
        
        ogl("move",-x!,y!,-z!)
        ogl("rotate",rx!,ry!,rz!)
        ogl("cuboid",sx!,sy!,sz!)
        
        ogl("pop")
        
endproc

proc ogl.createplane

        parameters x!,y!,z! , sx!,sy! , rx!,ry!,rz!
        
        ogl("push")
        
        ogl("move",-x!,y!,-z!)
        ogl("rotate",rx!,ry!,rz!)
        ogl("quad",sx!,sy!)
        
        ogl("pop")
        
endproc


proc terr.CollidSetPxSecure

        parameters x&,y&,c&
        
        case x&<0 : return 0
        case y&<0 : return 0
        case x&>terr.CollidXx&-1 : return 0
        case y&>terr.CollidYy&-1 : return 0

        terr.CollidSetPx x&,y&,c&
        
endproc

proc terr.SetPx

        parameters x&,y&,c&
        
        byte terr.mem#,y&*terr.xx&+x&=c&
        
endproc

proc terr.getpx

        parameters x&,y&
        
        return byte(terr.mem#,y&*terr.xx&+x&)
        
endproc

proc terr.CollidSetPx

        parameters x&,y&,c&
        
        byte terr.Collidmem#,y&*terr.CollidXx&+x&=c&
        
endproc

proc terr.CollidGetPx

        parameters x&,y&
        
        return byte(terr.Collidmem#,y&*terr.CollidXx&+x&)
        
endproc

proc terr.new

        parameters x&,y&
        
        terr.xx&:=x&
        terr.yy&:=y&
        
        terr.CollidXx&:=x&*5 // CollisionMem is with 5 times more precision 
        terr.CollidYy&:=y&*5 // to make small tunnels possible
        
        dim terr.mem#,terr.xx&*terr.yy&  
        dim terr.collidMem#,terr.CollidXx&*terr.CollidYy&
        
        clear terr.mem#
        clear terr.collidMem#
        
        terr.ypt&:=-1
        
        Ogl("Texture", Tx.floor&,sqrt(x&*y&))
        'Ogl("Color", 0,0.3,1,1)
        Ogl.createplane (x&/2-0.5)*gd!,0,(y&-0.5)*gd! , x&*gd!,y&*gd!  ,90,0,0
        Ogl("Texture", 0,0)
        Ogl("Color", 0.4,0.4,0.4,1)
        Ogl.createplane (x&/2-0.5)*gd!,gd!,(y&-0.5)*gd! , x&*gd!,y&*gd!  ,90,0,0

endproc

proc terr.add

        parameters s$
        
        declare i&,ls&,c&
        
        terr.ypt&+
        
        ls&:=len(s$)
        
        for i&:=1 to ls& do begin
        
                c&:=ord(mid$(s$,i&,1))
                terr.setpx i&-1,terr.ypt&,c&
        
        end

endproc

proc terr.dispose

        dispose terr.mem#
        dispose terr.collidMem#

endproc

proc terr.buildOglObjects

        declare y&,x&,c&
        
        for y&:=0 to terr.yy&-1 do begin
        
                for x&:=0 to terr.xx&-1 do begin
                
                        c&:=terr.getpx(x&,y&)
                
                        if c&==32

                        elseif c&==33 // ! open Door

                                Ogl("Texture", Tx.doorsteel&,1)
                                Ogl.createcube x&*gd!,0,y&*gd!-0.45  ,gd!*0.5,gd!,gd!*0.1,  0,0,0
                                Ogl.createcube x&*gd!,0,y&*gd!+0.45  ,gd!*0.5,gd!,gd!*0.1,  0,0,0
                                Ogl("Texture", Tx.door&,1)
                                Ogl.createcube x&*gd!,0,y&*gd!  ,gd!*0.1,gd!,gd!,  0,0,0
                                Ogl("Texture", Tx.wall&,1)

                        elseif c&==124 // | Door

                                Ogl("Texture", Tx.door&,1)
                                ogl.createcube x&*gd!,0,y&*gd!  ,gd!*0.5,gd!,gd!,  0,0,0
                                Ogl("Texture", Tx.wall&,1)

                        elseif c&==45 // - Door

                                Ogl("Texture", Tx.door&,1)
                                ogl.createcube x&*gd!,0,y&*gd!  ,gd!,gd!,gd!*0.5,  0,0,0
                                Ogl("Texture", Tx.wall&,1)

                        elseif c&==88

                                ogl.createcube x&*gd!,0,y&*gd!  ,gd!,gd!,gd!,  0,0,0

                        elseif c&==62

                                terr.setpx x&,y&,32 //remove startUpSign ">"
                                xp&:=x&*5
                                yp&:=y&*5

                        endif   
                        

                end
                
        end
        
endproc

proc terr.BuildCollisionMap

        declare y&,x&,c&
        
        for y&:=0 to terr.yy&-1 do begin
        
                for x&:=0 to terr.xx&-1 do begin
                
                        c&:=terr.getpx(x&,y&)
                
                        if c&==32

                        elseif c&==88 // X

                                whileloop 7
                                
                                        terr.CollidSetPxSecure x&*5-2+&loop,y&*5-1,42
                                        terr.CollidSetPxSecure x&*5-2+&loop,y&*5+5,42
                                        
                                wend

                                whileloop 5
                                
                                        terr.CollidSetPxSecure x&*5-1,y&*5-1+&loop,42
                                        terr.CollidSetPxSecure x&*5+5,y&*5-1+&loop,42
                                        
                                wend

                        elseif c&==45 // - Door

                                whileloop 7
                                
                                        terr.CollidSetPxSecure x&*5-2+&loop,y&*5-1,42
                                        terr.CollidSetPxSecure x&*5-2+&loop,y&*5+5,42
                                        
                                wend

                                whileloop 5
                                
                                        terr.CollidSetPxSecure x&*5-1,y&*5-1+&loop,42
                                        terr.CollidSetPxSecure x&*5+5,y&*5-1+&loop,42
                                        
                                wend

                        elseif c&==124 // | Door

                                whileloop 7
                                
                                        terr.CollidSetPxSecure x&*5-2+&loop,y&*5-1,42
                                        terr.CollidSetPxSecure x&*5-2+&loop,y&*5+5,42
                                        
                                wend

                                whileloop 5
                                
                                        terr.CollidSetPxSecure x&*5-1,y&*5-1+&loop,42
                                        terr.CollidSetPxSecure x&*5+5,y&*5-1+&loop,42
                                        
                                wend

                        elseif c&==33 // | Door

                                whileloop 7
                                
                                        terr.CollidSetPxSecure x&*5-2+&loop,y&*5-1,43
                                        terr.CollidSetPxSecure x&*5-2+&loop,y&*5+5,43
                                        
                                wend

                                whileloop 5
                                
                                        terr.CollidSetPxSecure x&*5-1,y&*5-1+&loop,43
                                        terr.CollidSetPxSecure x&*5+5,y&*5-1+&loop,43
                                        
                                wend

                        endif   
                        

                end
                
        end

endproc

proc terr.Build

        terr.oglList&:=ogl("StartList")         
        terr.new 18,10
        
        Ogl("Color", 1.3,1.3,1.3,0.9)
        Ogl("Texture", Tx.wall&,1)
        
        
        terr.add "XXXXXXXXXXXXXXXXXX"
        terr.add "X>     !   |      "
        terr.add "XX XXX XXXXX      "
        terr.add "X    X X          "
        terr.add "X    X X          "
        terr.add "X    X XXXXXXXXXXX"
        terr.add "X    X           |"
        terr.add "X    XXX-XXXXXXXXX"
        terr.add "X                 "
        terr.add "XXXXXXXXXXXXXXXXXX"
        
        terr.buildOglObjects
        
        ogl("EndList")
        
        terr.BuildCollisionMap
        
endproc