Teinpäs tuosta wikipedian mukaisen käännöksen CB:lle. Funktio MemBresenham laskee kahden pisteen välisten ruutujen koordinaatit järjestyksessä ja palauttaa ne muistipalassa, jonka ensimmäinen kokonaisluku on ruutujen määrä. Kun tarkistaa onko näissä ruuduissa seinää, saa helposti jätettyä piirtämättä seinän taakse jäävät ruudut.
Esimerkissä välilyönti piirtää viivan kahden ruudun välille ja matkalle osuvat ruudut värjäytyvät vihreän sävyihin.
Code: Select all
SCREEN 800,600
Const resolution = 40
Const size = 12
Repeat
Color cbwhite
For x=0 To resolution-1
For y=0 To resolution-1
Box x*size+10,y*size+10,size,size,0
Next y
Next x
If mem Then
määrä = PeekInt(mem,0)
o=0
For i=4 To MEMBlockSize(mem)-1 Step 8
o+1
xx=PeekInt(mem,i)
yy=PeekInt(mem,i+4)
väri# = 255-(Float(o)/float(määrä))*255.0
Color 0,väri,0
Box xx*size+10,yy*size+10,size,size,1
Next i
Color cbred
Line lx*size+10+size/2,ly*size+10+size/2,lxx*size+10+size/2,lyy*size+10+size/2
EndIf
If KeyDown(cbkeyspace) Then
If mem Then DeleteMEMBlock mem : mem=0
lx=Rand(resolution-1)
ly=Rand(resolution-1)
lxx=Rand(resolution-1)
lyy=Rand(resolution-1)
mem = MemBresenham(lx,ly,lxx,lyy)
ClearKeys
EndIf
DrawScreen
Forever
Function MemBresenham(x,y,xx,yy)
mem=MakeMEMBlock(4)
PokeInt mem,0,0
lw=Abs(xx-x)
lh=Abs(y-yy)
w=Max(lh,lw)
h=Min(lh,lw)
If lw>lh Then
If x<xx Then
s0=x
t0=y
s1=xx
t1=yy
Else
s0=xx
t0=yy
s1=x
t1=y
EndIf
Else
If y<yy Then
s0=y
t0=x
s1=yy
t1=xx
Else
s0=yy
t0=xx
s1=y
t1=x
EndIf
EndIf
If t0<t1 Then
tstep=1
Else
tstep=-1
EndIf
virhe = w/2
t = t0
For s=s0 To s1
oldsize = MEMBlockSize(mem)
ResizeMEMBlock mem,oldsize+8
PokeInt mem,0,PeekInt(mem,0)+1
If lw>lh Then
PokeInt mem,oldsize,s
PokeInt mem,oldsize+4,t
Else
PokeInt mem,oldsize,t
PokeInt mem,oldsize+4,s
EndIf
virhe = virhe + h
If virhe >= w Then
t = t + tstep
virhe = virhe - w
EndIf
Next s
Return mem
End Function
EDIT: Taas hidastelin