Abt. Bitterfeld
=========
Ein Bitfeld in 2D, da benötigt man die richtigen Zeilen/Spalten/Byte/Bit-Ansprechroutinen. Zeilen und Spalten beginnen bei 0, Überhang tritt allenfalls beim letzten Byte auf. Die bits, die jeweils gleichen Stellenwert im Byte haben, sind hier gleichfärbig eingefärbt.
Gruss
P.S.: Hat gedauert, bis das geklappt hat. Daher "Bitterfeld"
Code
Windowtitle "Kompaktes 2D-Bitfeld schreiben und lesen"
'(CL) Copyleft 2018-04 by P.Specht, Wien - OHNE JEDE GEWÄHR!
var Zeilen&=66
var Spalten&=123
var Dot&=11 'Größe
var Farbe&=rgb(255,255,255)
var Hintergrd&=rgb(0,255,255)
var ob_rand&=dot&\2
var li_rand&=dot&\2
Windowstyle 24:Window 0,0-%maxx,%maxy
Declare Bereich#:Dim Bereich#,(Zeilen&*Spalten&+7)\8
Declare z&,s&, by&,mo&,w&
Proc Setbitf :parameters b#,Zeilen&,Spalten&,z&,s&,v&
case (z&<0) or (z&>=Zeilen&) or (s&<0) or (s&>=Spalten&):return
var by&=(z&*Spalten&+s&)\8:var mo&=(z&*Spalten&+s&) mod 8
var w&=byte(b#,by&):w&=setbit(w&,mo&,v&):byte b#,by& = w&
Endproc
Proc Show
Whileloop 0,Zeilen&-1:z&=&Loop
Whileloop 0,Spalten&-1:s&=&Loop
by&=(z&*Spalten&+s&)\8
mo&=(z&*Spalten&+s&) mod 8
if testbit(byte(Bereich#,by&),mo&)
usepen 0,dot&,Farbe&
else
usepen 0,dot&,rgb(0,mo&*30,mo&*30)
endif
Line li_rand&+dot&*s&,ob_rand&+dot&*z&\
- li_rand&+dot&*s&,ob_rand&+dot&*z&+1
'... schneller als Rectangle
endwhile
endwhile
endproc
'********************* Hauptteil *******************
Selbsttest:
declare iz&,is&
Whileloop Zeilen&-2,Zeilen&-1:iz&=&Loop
Whileloop Spalten&-10,Spalten&-1:is&=&Loop
setbitf(Bereich#,Zeilen&,Spalten&,iz&,is&,1)
show
sound 4000,22
setbitf(Bereich#,Zeilen&,Spalten&,iz&,is&,0)
endwhile
endwhile
SMILEY:show
dispose Bereich#
Print "\n Selbsttest OK! "
waitinput
END
' Bonus:
Proc SMILEY :whileloop 0,359,1
z&=32.5+30*sin(&Loop/180*Pi()):s&=60.5+30*cos(&Loop/180*Pi())
SetBitf(Bereich#,Zeilen&,Spalten&, z&,s&,1):z&=32.5+31*sin(&Loop/180*Pi())
s&=60.5+31*cos(&Loop/180*Pi()):SetBitf(Bereich#,Zeilen&,Spalten&, z&,s&,1)
z&=24.5+4*sin(&Loop/180*Pi()):s&=50.5+4*cos(&Loop/180*Pi())
SetBitf(Bereich#,Zeilen&,Spalten&, z&,s&,1):z&=24.5+2*sin(&Loop/180*Pi())
s&=70.5+6*cos(&Loop/180*Pi()):SetBitf(Bereich#,Zeilen&,Spalten&, z&,s&,1)
if (&Loop>20) and (&Loop<160):z&=25.5+30*sin(&Loop/180*Pi())
s&=60.5+20*cos(&Loop/180*Pi()):SetBitf(Bereich#,Zeilen&,Spalten&, z&,s&,1)
endif:endwhile : farbe&=rgb(255,255,0)
EndProc
Alles anzeigen