Buchempfehlung
Windows System Programming
Windows System Programming
Das Kompendium liefert viele interessante Informationen zur Windows-Programmierung auf Englisch. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

Speicherzugriffsfehler ??

Uploader:Mitgliedflo
Datum/Zeit:17.04.2008 17:05:37

'das programm ist so nicht lauffähig, weil ein haufen grafiken
'fehlen... ich werde das demnächst als zip mit grafiken
'reinstellen...

'das problem ist, dass unter linux wenn ich erst auf "4"
'drücke, dann einen "minigegner" auswähle (gegnertyp setzen)
'dann auf "5" um ihn zu positionieren, manchmal sofort,
'manchmal bei der ersten mausbewegung, manchmal garnicht
'ein speicherzugriffsfehler auftritt
'wenn ich mit -ex oder -exx compile, dann tritt der fehler
'nicht auf, allerdings springt er zu FUCK (nette bezeichnung
'gell ^^) und zeigt ein paar zeilen (unter anderem: fehler=0
'zeilennummer=-1...) und beendet sich oder hängt sich auf
'nichtmal auf SIGTERM reagiert er, er muss gekillt werden

'ich denke dieser fehler hängt mit PUT/GET zusammen, aber kA
'ich hoffe ihr könnt mir da helfen
'mfg
'flo

declare sub loadlevel(datei as string)
declare sub savelevel(datei as string)
#define false 0
#define true not false
'tiles: ok
'gegner: x,y,energy: ok
'

'öffnen: fehlt
'speichern: in arbeit

'dateiformat:
'xlen,ylen
'chr(tile),chr(iif(solid,1,iif(half,2,0))),...
'...
'...
'chr(Badguy(1).typ),.x,.y,.vx,.energy


#define DEBUG

#include "inc\pload\ploadlib.bas"
#include "fbgfx.bi"

#macro conswrite(bla)
    #ifdef DEBUG
        open CONS for output as #132
        ?#132,bla
        close #132
    #endif
#endmacro

#define marked rgb(255,0,0)
#define unmarked rgb(127,127,127)
#define solidfarbe rgb(255,255,255)
#define halffarbe rgb(127,127,127)
#define nixfarbe rgb(32,32,32)
#define markfarbe rgb(255,255,0)
#define inrect(x___,y___,x___1,x___2,y___1,y___2) (((x___>x___1) AND (x___<x___2)) OR ((y___>y___1) AND (y___<x___2)))


declare sub fully_drawbadguys
declare sub redraw (b_x as byte,b_y as byte)
declare sub fully_redraw
declare sub drawsolid (b_x as byte,b_y as byte)
declare sub fully_drawsolid


const gfxpath="gfx\gfx\"

screenres 800,600,24

dim shared Tileset (0 to 153) as fb.image ptr
dim shared MiniGegner(1 to 3) as fb.image ptr
dim shared Sprite(1 to 3) as fb.image ptr
dim shared SpriteHG(1 to 3) as fb.image ptr
dim shared as fb.image ptr HPic,SPic


dim as integer i
for i=1 to 3
    Minigegner(i)=imagecreate(32,32)
next
bload "gfx\leveleditor\wolf.bmp",Minigegner(1)
bload "gfx\leveleditor\dragon.bmp",Minigegner(2)
bload "gfx\leveleditor\spinne.bmp",Minigegner(3)
Sprite(1)=imagecreate(46,30)
Sprite(2)=imagecreate(96,63)
Sprite(3)=imagecreate(11,13)
SpriteHG(1)=imagecreate(46,30)
SpriteHG(2)=imagecreate(96,63)
SpriteHG(3)=imagecreate(11,13)
bload gfxpath+"Wolf\r1.bmp", Sprite(1)
bload gfxpath+"Dragon\r1.bmp", Sprite(2)
bload gfxpath+"Spinne\1.bmp",Sprite(3)
'drawguyalt=imagecreate (1,1)


'for i=1 to 4
'    Tileset(i)=pload("F:\hmm\supertux-0.1.3\data\images\tilesets\block"&i &".png")
'next
'Tileset(5)=pload("F:\hmm\supertux-0.1.3\data\images\tilesets\brick0.png")
'Tileset(6)=pload("F:\hmm\supertux-0.1.3\data\images\tilesets\grey.png")
for i=1 to 131
tileset(i)=imagecreate(32,32)
bload "/mnt/win_e/tileset/tile"+rtrim(ltrim(str(i)))+".bmp",Tileset(i)
next
for i=1 to 14
tileset(i+131)=pload("/mnt/win_e/tileset/tile"+rtrim(ltrim(str(i)))+".png")
next

HPic=imagecreate(32,32)
SPic=imagecreate(32,32)

bload "gfx\leveleditor\H.bmp",HPic
bload "gfx\leveleditor\S.bmp",SPic



type TBlock
    solid as byte
    half as byte
    tile as ubyte
end type
dim shared as TBlock Block (25,18),drawblock


dim as fb.image ptr alt,black,white
alt=imagecreate (32,32)
black = imagecreate (32,32,rgb(0,0,0))
white=imagecreate(32,32,rgb(255,255,255))
tileset(0)=black
for i=131+14+1 to 153
tileset(i)=black
next


dim as integer x,y,buttons,bla,xx,yy
dim as byte action,bx,by,gegnertyp,gegnernr,gegnerenergy
dim as string ink
gegnernr=1
type TGuy
    x as integer
    y as integer
    vx as integer
    width as integer
    height as integer
    energy as integer
    typ as byte
end type

dim as TGuy Guy(1 to 3)
with Guy(1)
    .width=46
    .height=30
    .typ=1
    .vx=10
end with
with Guy(2)
    .width=96
    .height=63
    .typ=2
end with
with Guy(3)
    .width=11
    .height=13
    .typ=3
end with

dim shared BadGuy (1 to 10) as TGuy

on error goto fuck
do
    sleep 20
    if action <> 5 then put (bx*32-32,by*32-32),alt,pset else put (x,y),SpriteHG(gegnertyp),pset

    getmouse x,y,,buttons
    if x<0 then do:sleep 20:getmouse x,y,,buttons:loop while x<0
    'locate 1,1:?x,y:sleep
    bx=fix(x/32)+1:by=fix(y/32)+1
    'screenlock
    if action <> 5 then
        get (bx*32-32,by*32-32)-(bx*32-1,by*32-1),alt
        line (bx*32-32,by*32-32)-(bx*32-1,by*32-1),markfarbe,B
    else
        get (x,y)-step(guy(gegnertyp).width,guy(gegnertyp).height),SpriteHG(gegnertyp)
    end if
    ink=inkey
    'screenunlock
    select case action
    case 1: if buttons then
                put (bx*32-32,by*32-32),alt,pset
                block(bx,by)=drawblock
                redraw (bx,by)
                get (bx*32-32,by*32-32)-(bx*32-1,by*32-1),alt
            end if
    case 2: if buttons then
                put (bx*32-32,by*32-32),alt,pset
                block(bx,by)=drawblock
                redraw (bx,by)
                drawsolid (bx,by)
                get (bx*32-32,by*32-32)-(bx*32-1,by*32-1),alt
            end if
    case 3: if buttons then
                'screenlock
                put (bx*32-32,by*32-32),alt,pset
                if bx=2 and by=4+14 then
                    drawblock.solid=not(drawblock.solid)
                    if drawblock.solid then drawblock.half=0

                    put (32,96+14*32),SPic,pset
                    if drawblock.solid = 0 then put (32,96+14*32),black,alpha,127
                    put (96,96+14*32),HPic,pset
                    if drawblock.half = 0 then put (96,96+14*32),black,alpha,127

                    'draw string (44,108),"S",iif(drawblock.solid,marked,unmarked)
                    get (bx*32-32,by*32-32)-(bx*32-1,by*32-1),alt
                elseif bx=4 and by=4+14 then
                    drawblock.half=not(drawblock.half)
                    if drawblock.half then drawblock.solid=0

                    put (32,96+14*32),SPic,pset
                    if drawblock.solid = 0 then put (32,96+14*32),black,alpha,127
                    put (96,96+14*32),HPic,pset
                    if drawblock.half = 0 then put (96,96+14*32),black,alpha,127
                    'draw string (108,108),"H",iif(drawblock.half,marked,unmarked)
                    get (bx*32-32,by*32-32)-(bx*32-1,by*32-1),alt
                elseif by>=2 and by<=8 then
                    if bx>=1 and bx<=24 then drawblock.tile= bx-1  + (by-2)*23-1
                    conswrite ("Mode 3: Selected Tile:";drawblock.tile)
                    i=0
                    for yy=2 to 8
                        for xx=1 to 23
                            put (xx*32,yy*32-32),Tileset(i),pset
                            i=i+1
                            if i>145 then exit for
                        next
                    next
                    i=0
                    for yy=2 to 8
                        for xx=1 to 23
                            if i= drawblock.tile then line (xx*32,yy*32-32)-step(31,31),rgb(255,0,0),B'put (xx*32,yy*32-32),white,alpha,127
                            i=i+1
                            if i>145 then exit for
                        next
                    next

                    'for j=1 to
                    'for i= 1 to 6
                    '    if i <> drawblock.tile then put (i*32,32),black,alpha,127
                    'next
                    get (bx*32-32,by*32-32)-(bx*32-1,by*32-1),alt
                end if
                do:sleep 10:getmouse bla,bla,,buttons:loop until buttons=0
                'screenunlock
            end if
        case 4: if buttons then
                    put (bx*32-32,by*32-32),alt,pset
                    if by=2 then
                        if bx>=2 and bx<=4 then
                            gegnertyp=bx-1
                            for i=1 to 3
                                put (i*32,32),MiniGegner(i),pset
                            next
                            for i=1 to 3
                                if i <> gegnertyp then put (i*32,32),black,alpha,127
                            next

                        end if
                    elseif by=4 and bx=2 then
                        locate 15,6
                        ?"   "
                        locate 15,6
                        input "",gegnernr
                    elseif by=4 and bx=5 then
                        locate 15,18
                        ?"    "
                        locate 15,18
                        input "",gegnerenergy
                    end if
                    get (bx*32-32,by*32-32)-(bx*32-1,by*32-1),alt
                end if
        case 5: put (x,y),Sprite (gegnertyp),alpha,127
                if buttons then
                    Badguy(gegnernr)=guy(gegnertyp):badguy(gegnernr).energy=gegnerenergy
                    BadGuy(gegnernr).x=x:Badguy(gegnernr).y=y
                    ink="5"
                end if


    end select
    screensync
    select case lcase(ink)
    case "1" to "5":   cls
                'if action=1 then action=0 else action=1
                action=val(ink)
                select case action
                case 1: fully_redraw
                case 2: fully_redraw:fully_drawsolid
                case 3: i=0
                        for yy=2 to 8
                            for xx=1 to 23
                                'conswrite(i)
                                'sleep
                                put (xx*32,yy*32-32),Tileset(i),pset
                                i=i+1
                                if i>145 then exit for
                            next
                        next
                        i=0
                        for yy=2 to 8
                            for xx=1 to 23
                                if i= drawblock.tile then line (xx*32,yy*32-32)-step(31,31),rgb(255,0,0),B'put (xx*32,yy*32-32),white,alpha,127
                                i=i+1
                                if i>145 then exit for
                            next
                        next

                        'line (32,96)-step(63,127),rgb(255,255,255),B
                        'line (96,96)-step(127,127),rgb(255,255,255),B
                        put (32,96+14*32),SPic,pset
                        if drawblock.solid = 0 then put (32,96+14*32),black,alpha,127
                        put (96,96+14*32),HPic,pset
                        if drawblock.half = 0 then put (96,96+14*32),black,alpha,127
                case 4: for i=1 to 3
                            put (i*32,32),MiniGegner(i),pset
                        next
                        for i=1 to 3
                            if i <> gegnertyp then put (i*32,32),black,alpha,127
                        next
                        locate 14,2
                        ?"Gegnernr"
                        locate 14,15
                        ?"Energie"
                        locate 15,6
                        ?trim(str(gegnernr))
                        locate 15,18
                        ?trim(str(gegnerenergy))
                case 5: fully_redraw:fully_drawsolid:fully_drawbadguys
                        conswrite(gegnertyp)
                        conswrite(guy(gegnertyp).width)
                        conswrite(guy(gegnertyp).height)
                        conswrite("1")
                        'imagedestroy drawguyalt
                        conswrite("2")
                        'drawguyalt=imagecreate(guy(gegnertyp).width,guy(gegnertyp).height)
                        conswrite("3")
                        get (x,y)-step(guy(gegnertyp).width,guy(gegnertyp).height),SpriteHG(gegnertyp)
                        conswrite("4")
                end select
                get (bx*32-32,by*32-32)-(bx*32-1,by*32-1),alt
    case "S","S": savelevel "tempdatei.lvl"
    case "l","l": loadlevel "tempdatei.lvl"
    case chr(27):end
    end select
loop

sub redraw (b_x as byte,b_y as byte)
    'screenlock
    put (b_x*32-32,b_y*32-32),tileset(block(b_x,b_y).tile),pset
    'screenunlock
end sub

sub fully_redraw
    'screenlock
    dim as byte b_x,b_y
    for b_x=1 to 25
        for b_y=1 to 18
            put (b_x*32-32,b_y*32-32),tileset(block(b_x,b_y).tile),pset
        next
    next
    'screenunlock
end sub

sub drawsolid (b_x as byte,b_y as byte)
    line (b_x*32-32,b_y*32-32)-(b_x*32-1,b_y*32-1),nixfarbe,B
    if block (b_x,b_y).half then line (b_x*32-32,b_y*32-32)-(b_x*32-1,b_y*32-1),halffarbe,B
    if block (b_x,b_y).solid then line (b_x*32-32,b_y*32-32)-(b_x*32-1,b_y*32-1),solidfarbe,B
end sub

sub fully_drawsolid
    dim as byte b_x,b_y
    for b_x=1 to 25
        for b_y=1 to 18
            drawsolid(b_x,b_y)
        next
    next
end sub

sub fully_drawbadguys
    dim as ubyte i
    for i=1 to 10
        if badguy(i).energy<>0 then put (badguy(i).x,badguy(i).y),Sprite(badguy(i).typ),trans
    next
end sub

sub savelevel (datei as string)
    dim as integer FF,xt,yt,i
    FF=freefile
    open datei for output as #FF
    ?#FF,chr(25);chr(18);
    for yt=1 to 18
        for xt= 1 to 25
            ?#FF,chr(block(xt,yt).tile);chr(iif(block(xt,yt).solid,2,iif(block(xt,yt).half,1,0)));
        next
    next
    for i=1 to 10
        with badguy(i)
            ?#FF,mki(.x)+mki(.y)+mki(.vx)+chr(.energy);
        end with
    next
    close #FF
end sub

sub loadlevel(datei as string)
    dim as integer FF,xt,yt,i,maxx,maxy
    FF=freefile
    open datei for input as #FF
    maxx=asc(input (1,FF))
    maxy=asc(input (1,FF))
    for yt=1 to maxy
        for xt=1 to maxx
            with block(xt,yt)
                .tile=asc(input(1,FF))
                i=asc(input(1,FF))
                if i=2 then .solid=true:.half=true else if i=1 then .solid= false : .half=true else .solid=false:.half=false
            end with
        next
    next
    for i=1 to 10
        with badguy(i)
            .x=cvi(input(4,FF))
            .y=cvi(input(4,FF))
            .vx=cvi(input(4,FF))
            .energy=asc(input(1,FF))
        end with
    next
    close #FF
end sub

fuck:
conswrite("fuck")
conswrite (err)
conswrite (erl)
end