Commit 4206f5fd by kollo

version 1.22 (unvollstaendig)

parent 3f0ea8b4
......@@ -5,13 +5,14 @@
' Ported to X11-Basic
'
' latest modified: 2011-08-10 for X11-Basic V.1.18
' latest modified: 2013-03-10 for X11-Basic V.1.20
'
DIM pxU(4),pyU(4)
if SENSOR?>0 ! is probably an Android device
IF SENSOR?>0 ! is probably an Android device
imgpath$="/storage/tmp/"
else
ELSE
imgpath$="/tmp/"
endif
ENDIF
meldung$="WSHOW (c) Markus Hoffmann 1989 - 2001"
maxfl=80000
sortstart=0
......@@ -25,19 +26,19 @@ DIM dist(maxfl)
DIM index%(maxfl)
'
'
weiss=GET_COLOR(65535,65535,65535)
schwarz=GET_COLOR(0,0,0)
grau=GET_COLOR(32000,32000,32000)
gelb=GET_COLOR(65535,65535,32000)
blau=GET_COLOR(32000,32000,65535)
rot=GET_COLOR(32000,0,0)
weiss=COLOR_RGB(1,1,1)
schwarz=COLOR_RGB(0,0,0)
grau=COLOR_RGB(0.5,0.5,0.5)
gelb=COLOR_RGB(1,1,0.5)
blau=COLOR_RGB(0.5,0.5,1)
rot=COLOR_RGB(0.5,0,0)
bildcount=1
bx%=0
by%=0
bw%=600
bh%=400
get_geometry 1,bx%,by%,bw%,bh%
GET_GEOMETRY 1,bx%,by%,bw%,bh%
CLIP bx%,by%,bw%,bh%
' Koordinaten:
'
......@@ -91,7 +92,7 @@ WHILE EXIST(imgpath$+"bild"+STR$(bildcount,3,3,1)+".xpm")
BGET #1,VARPTR(t$),LEN(t$)
CLOSE #1
PUT 0,0,t$
VSYNC
SHOWPAGE
PAUSE 0.01
film$(bildcount)=t$
INC bildcount
......@@ -102,7 +103,7 @@ IF bildcount>=72
DO
FOR i=0 TO bildcount-1
PUT 0,0,film$(i)
VSYNC
SHOWPAGE
PAUSE 0.02
NEXT i
LOOP
......@@ -140,7 +141,7 @@ DO
COLOR gelb
PBOX 400,170,400+sortzeit*50,178
PBOX 400,190,400+plotzeit*20,198
VSYNC
SHOWPAGE
SAVEWINDOW imgpath$+"bild"+STR$(bildcount,3,3,1)+".xpm"
INC bildcount
EXIT IF stwink>2*pi
......@@ -187,7 +188,7 @@ RETURN
PROCEDURE calc
LOCAL z,zz,zzz,x,y,x,yy,t
PRINT "calculate surfaces ..."
VSYNC
SHOWPAGE
t=CTIMER
' goto kug
FOR y=y2 DOWNTO y1 STEP sy
......@@ -201,7 +202,7 @@ PROCEDURE calc
NEXT x
NEXT y
PRINT anzfl;" elements in ";CTIMER-t;" Sekunden."
VSYNC
SHOWPAGE
kug:
LOCAL r,spsp,st,phi,theta,x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4
......@@ -224,7 +225,7 @@ kug:
torus:
GPRINT anzfl;" Flchen. in ";CTIMER-t;" Sekunden."
VSYNC
SHOWPAGE
RETURN
PROCEDURE sort
......@@ -259,7 +260,7 @@ PROCEDURE sort
@progress(anzfl,i)
print
PRINT "in ";ctimer-t;" Sekunden."
VSYNC
SHOWPAGE
RETURN
PROCEDURE save
OPEN "O",#1,imgpath$+"welt.xxx"
......@@ -279,7 +280,7 @@ PROCEDURE load
PRINT meldung$
BGET #1,VARPTR(welt(0)),anzfl*8*13
CLOSE #1
VSYNC
SHOWPAGE
RETURN
PROCEDURE plot
plottime=TIMER
......@@ -355,14 +356,14 @@ PROCEDURE plot
pyU(3)=@ky(welt(9+13*i),welt(10+13*i),welt(11+13*i))
POLYFILL 4,pxU(),pyU()
IF TIMER-ptimer>1
VSYNC
SHOWPAGE
@progress(anzfl,i)
ptimer=TIMER
ENDIF
ENDIF
NEXT i
@progress(anzfl,i)
VSYNC
SHOWPAGE
PRINT "Plotted in ";ROUND(TIMER-plottime);" sec."
RETURN
'
......@@ -425,5 +426,5 @@ FUNCTION ky(x,y,z)
ENDFUNC
procedure progress(a,b)
PRINT chr$(13);"[";string$(b/a*32,"-");">";string$((1.03-b/a)*32,"-");"| ";str$(int(b/a*100),3,3);"% ]";
flush
FLUSH
RETURN
......@@ -7,8 +7,9 @@
<H1>Index of /examples/3D-graphics</H1>
<HR>
<pre>
<A HREF="../">Parent Directory</A>
<A HREF="3Dshow.bas">3Dshow.bas</A> 9k<A HREF="../../screenshots/3Dshow.png">(Screenshot)</A>
<A HREF="../">Parent Directory</A>
10k 1993-08-10 <A HREF="3Dshow.bas">3Dshow.bas</A> calculates and draws 3 dimentional Objects<A HREF="../../screenshots/3Dshow.png">(Screenshot)</A>
3k 1990-08-10 <A HREF="wkug.bas">wkug.bas</A> Calculates Surfaces of two hollow Balls and saves it into a file
</PRE><HR>
</BODY></HTML>
......@@ -2,7 +2,7 @@
' It then can be displayed with 3Dshow.bas
' (c) Markus Hoffmann 1990
PRINT "MAKE-WORLD (c) Markus Hoffmann"
PRINT "MAKE-WORLD (c) Markus Hoffmann 1990"
meldung$="Surfaces of two hollow Balls"+chr$(0)
maxworld%=10000
mf%=maxworld%*13*8
......@@ -36,7 +36,7 @@ st=PI/15
FOR phi=0 TO 2*PI STEP spsp
FOR theta=0.05 TO PI STEP st
PRINT chr$(13);"Flchen:"'anzworld%;
flush
FLUSH
@polar1(r,theta,phi)
@polar2(r,theta+st,phi)
@polar3(r,theta+st,phi+spsp)
......@@ -59,7 +59,7 @@ FOR phi=0 TO 2*PI STEP spsp
@add4fl(16,x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4)
NEXT theta
NEXT phi
print
PRINT
'
PRINT "Welt: ";anzworld%;" Elemente..."
@saveworld
......@@ -119,5 +119,5 @@ RETURN
'
PROCEDURE ende
FREE world%
quit
QUIT
RETURN
' It is possible to modify the X11-Basic preferences under Android by
' reading or writing the the files under this directory:
' chdir "/data/data/net/sourceforge/x11basic"
a$=FSFIRST$("/data/data/net.sourceforge.x11basic")
f$="net.sourceforge.x11basic_preferences.xml"
while len(a$)
print a$
a$=FSNEXT$()
wend
print system$("cd /data/data/net.sourceforge.x11basic/shared_prefs ; cat myappraterdialog.xml")
print "------"
print system$("cd /data/data/net.sourceforge.x11basic/shared_prefs ; cat "+f$)
print "------"
print system$("cd /data/data/net.sourceforge.x11basic/shared_prefs ; ls ")
print "------"
print system$("cd /data/data/net.sourceforge.x11basic ; cat cache/* ")
' Displays Atari-ST 8*16 fixed Fonts (c) Markus Hoffmann
scale=2
' Displays Atari-ST 8*16 fixed Fonts (c) Markus Hoffmann 2004-04-12
'
scale=2 ! define the size of the characters
text$="This example demonstrates the use of the old Atari-ST fonts!"+chr$(14)+chr$(15)+" We used "
COLOR GET_COLOR(65535,65535,0)
COLOR COLOR_RGB(0.1,0,0)
clearw 1
GET_GEOMETRY 1,bx%,by%,bw%,bh%
PBOX bx%,by%,bw%,200
COLOR COLOR_RGB(1,1,0)
FILESELECT "FONT-Laden","./*.fnt","",f$
FILESELECT "load FONT","./*.fnt","",f$
IF LEN(f$)
IF EXIST(f$)
OPEN "I",#1,f$
......@@ -17,18 +21,16 @@ IF LEN(f$)
ENDIF
@text(text$)
ENDIF
PAUSE 10
QUIT
END
PROCEDURE text(t$)
LOCAL i
FOR i=0 TO LEN(t$)-1
char=PEEK(VARPTR(t$)+i) AND 255
@char(x,y,char)
VSYNC
SHOWPAGE
PAUSE 0.1
ADD x,8*scale
IF x>=640
IF x>=bw% or char=31 or x>=8*scale*32
x=0
ADD y,16*scale
ENDIF
......
dim width(128)
' Read and decode a SIGNUM2 font
' originally written in GFA-BASIC 1989
'
DIM width(128)
f$="grotlt.e24"
f$="normande.e24"
f$="/work/CDs/ATARI-ST_v_2/st/d/chsets/grotlt.p24"
open "I",#1,f$
OPEN "I",#1,f$
d=10
clearw
seek #1,0
header$=input$(#1,140)
for i=0 to 128-1
width(i)=CVI(reverse$(input$(#1,4)))
next i
memdump varptr(header$),140
data$=input$(#1,lof(#1)-140-512)
CLEARW
SEEK #1,0
header$=INPUT$(#1,140)
FOR i=0 TO 128-1
width(i)=CVI(REVERSE$(INPUT$(#1,4)))
NEXT i
MEMDUMP VARPTR(header$),140
data$=INPUT$(#1,LOF(#1)-140-512)
wx=0
for c=1 to 63
@disp(wx,100,c)
next c
FOR c=1 TO 63
@disp(wx,100,c)
NEXT c
wx=0
for c=64 to 127
@disp(wx,200,c)
next c
keyevent
quit
FOR c=64 TO 127
@disp(wx,200,c)
NEXT c
KEYEVENT
QUIT
procedure disp(x,y,c)
local o,w,h,d
PROCEDURE disp(x,y,c)
LOCAL o,w,h,d
o=width(c)
h=(width(c+1)-o)/2
d=peek(varptr(data$)+o)
w=peek(varptr(data$)+o+1)
w=peek(varptr(data$)+o+2)
text x,y+50,str$(w)
print peek(varptr(data$)+o+1),peek(varptr(data$)+o+3),w
print "char ";c;" offs=";d
add y,d
add o,4
sub h,2
for j=0 to h-1
a=peek(varptr(data$)+o+j*2)*256+(peek(varptr(data$)+o+1+j*2) and 255)
for i=0 to 15
if btst(a,i)
plot x+15-i,y
endif
next i
inc y
next j
vsync
add wx,w
return
d=PEEK(VARPTR(data$)+o)
w=PEEK(VARPTR(data$)+o+1)
w=PEEK(VARPTR(data$)+o+2)
TEXT x,y+50,STR$(w)
PRINT PEEK(VARPTR(data$)+o+1),PEEK(VARPTR(data$)+o+3),w
PRINT "char ";c;" offs=";d
ADD y,d
ADD o,4
SUB h,2
for j=0 to h-1
a=PEEK(VARPTR(data$)+o+j*2)*256+(PEEK(VARPTR(data$)+o+1+j*2) AND 255)
FOR i=0 TO 15
IF BTST(a,i)
PLOT x+15-i,y
ENDIF
NEXT i
INC y
NEXT j
SHOWPAGE
ADD wx,w
RETURN
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
<HTML>
<HEAD><TITLE>Index of /examples/Atari-ST</TITLE></HEAD>
<BODY>
<H1>Index of /examples/Atari-ST</H1>
<HR>
<pre>
<A HREF="../">Parent Directory</A>
17k 2004-04-12 <A HREF="68000dis.bas">68000dis.bas</A> MC68000 Disassembler
1k 2004-04-12 <A HREF="ST-font-show.bas">ST-font-show.bas</A> Displays Atari-ST 8*16 fixed Fonts <A HREF="../../screenshots/font.png">(Screenshot)</A>
2k 2002-05-06 <A HREF="showstpic.bas">showstpic.bas</A> Decodes a monochrome picture (32000 Bytes) *.pic from ATARI ST and displays it.
2k 2002-05-06 <A HREF="rsc.test.bas">rsc.test.bas</A> Opens Object trees from a ATARI ST resource file (*.RSC) and displays them.
13k 2003-08-10 <A HREF="rsc2gui.bas">rsc2gui.bas</A> Utility to convert ATARI ST RSC Files to GUI Files
</PRE><HR>
</BODY></HTML>
' Example program how to use the GUI objects. All who are familiar with the
' GEM AES definitions of ATARI ST will find it similar.
' (c) Markus hoffmann 2002
' (c) Markus Hoffmann 2002 2002-05-05
strings$="Please select from given choices:"+chr$(0)
btext1$="OK"+chr$(0)
btext2$="CANCEL"+chr$(0)
strings$="Please select from given choices:"+CHR$(0)
btext1$="OK"+CHR$(0)
btext2$="CANCEL"+CHR$(0)
x=100
y=100
w=320
h=200
sel=9
s$=""
for i=0 to sel-1
s$=s$+str$(i+1)+chr$(0)
next i
FOR i=0 TO sel-1
s$=s$+STR$(i+1)+CHR$(0)
NEXT i
name$="Itsme"+string$(30,chr$(0))
buf$=space$(20)+chr$(0)
ted$=mkl$(varptr(name$))+mkl$(varptr(buf$))+mkl$(varptr(buf$))
ted$=ted$+mki$(3)+mki$(0)+mki$(0)+mki$(0x100)+mki$(0)+mki$(1)+mki$(len(name$)-1)+mki$(len(buf$)-1)
name$="Itsme"+string$(30,CHR$(0))
buf$=SPACE$(20)+CHR$(0)
ted$=MKL$(VARPTR(name$))+MKL$(VARPTR(buf$))+MKL$(VARPTR(buf$))
ted$=ted$+MKI$(3)+MKI$(0)+MKI$(0)+MKI$(0x100)+MKI$(0)+MKI$(1)+MKI$(len(name$)-1)+MKI$(len(buf$)-1)
ob$=mki$(-1)+mki$(1)+mki$(5+sel)+mki$(20)+mki$(0)+mki$(16)
ob$=ob$+mkl$(0x21100)+mki$(x)+mki$(y)+mki$(w)+mki$(h)
ob$=MKI$(-1)+MKI$(1)+MKI$(5+sel)+MKI$(20)+MKI$(0)+MKI$(16)
ob$=ob$+MKL$(0x21100)+MKI$(x)+MKI$(y)+MKI$(w)+MKI$(h)
ob$=ob$+mki$(2)+mki$(-1)+mki$(-1)+mki$(28)+mki$(0)+mki$(0)
ob$=ob$+mkl$(varptr(strings$))+mki$(16)+mki$(20)+mki$(200)+mki$(20)
ob$=ob$+MKI$(2)+MKI$(-1)+MKI$(-1)+MKI$(28)+MKI$(0)+MKI$(0)
ob$=ob$+MKL$(VARPTR(strings$))+MKI$(16)+MKI$(20)+MKI$(200)+MKI$(20)
ob$=ob$+mki$(3)+mki$(-1)+mki$(-1)+mki$(26)+mki$(1 or 4 or 2)+mki$(0)
ob$=ob$+mkl$(varptr(btext1$))+mki$(16)+mki$(160)+mki$(16*8)+mki$(16)
ob$=ob$+MKI$(3)+MKI$(-1)+MKI$(-1)+MKI$(26)+MKI$(1 or 4 or 2)+MKI$(0)
ob$=ob$+MKL$(VARPTR(btext1$))+MKI$(16)+MKI$(160)+MKI$(16*8)+MKI$(16)
ob$=ob$+mki$(4)+mki$(-1)+mki$(-1)+mki$(26)+mki$(1 or 4)+mki$(0)
ob$=ob$+mkl$(varptr(btext2$))+mki$(170)+mki$(160)+mki$(16*8)+mki$(16)
ob$=ob$+MKI$(4)+MKI$(-1)+MKI$(-1)+MKI$(26)+MKI$(1 or 4)+MKI$(0)
ob$=ob$+MKL$(VARPTR(btext2$))+MKI$(170)+MKI$(160)+MKI$(16*8)+MKI$(16)
ob$=ob$+mki$(5+sel)+mki$(5)+mki$(5+sel-1)+mki$(20)+mki$(0)+mki$(32)
ob$=ob$+mkl$(-1)+mki$(50)+mki$(50)+mki$(200)+mki$(50)
ob$=ob$+MKI$(5+sel)+MKI$(5)+MKI$(5+sel-1)+MKI$(20)+MKI$(0)+MKI$(32)
ob$=ob$+MKL$(-1)+MKI$(50)+MKI$(50)+MKI$(200)+MKI$(50)
for i=0 to sel-2
ob$=ob$+mki$(5+i+1)+mki$(-1)+mki$(-1)+mki$(26)+mki$(1 or 16)+mki$(0)
ob$=ob$+mkl$(varptr(s$)+2*i)+mki$(10+i*20)+mki$(16)+mki$(16)+mki$(16)
ob$=ob$+MKI$(5+i+1)+MKI$(-1)+MKI$(-1)+MKI$(26)+MKI$(1 or 16)+MKI$(0)
ob$=ob$+MKL$(VARPTR(s$)+2*i)+MKI$(10+i*20)+MKI$(16)+MKI$(16)+MKI$(16)
next i
ob$=ob$+mki$(4)+mki$(-1)+mki$(-1)+mki$(26)+mki$(1 or 16)+mki$(0)
ob$=ob$+mkl$(varptr(s$)+2*(sel-1))+mki$(10+(sel-1)*20)+mki$(16)+mki$(16)+mki$(16)
ob$=ob$+MKI$(4)+MKI$(-1)+MKI$(-1)+MKI$(26)+MKI$(1 or 16)+MKI$(0)
ob$=ob$+MKL$(VARPTR(s$)+2*(sel-1))+MKI$(10+(sel-1)*20)+MKI$(16)+MKI$(16)+MKI$(16)
ob$=ob$+mki$(0)+mki$(-1)+mki$(-1)+mki$(29)+mki$(8 or 32)+mki$(0)
ob$=ob$+mkl$(varptr(ted$))+mki$(10)+mki$(110)+mki$(16*10)+mki$(16)
ob$=ob$+MKI$(0)+MKI$(-1)+MKI$(-1)+MKI$(29)+MKI$(8 or 32)+MKI$(0)
ob$=ob$+MKL$(VARPTR(ted$))+MKI$(10)+MKI$(110)+MKI$(16*10)+MKI$(16)
~form_dial(0,0,0,0,0,x,y,w,h)
~form_dial(1,0,0,0,0,x,y,w,h)
~objc_draw(varptr(ob$),0,-1,0,0)
vsync
print "Move the mouse and this tells you the OBJ-#:"
print "click the mouse to do the form."
while mousek=0
if mousex<>omx or mousey<>omy
mouse omx,omy
print objc_find(varptr(ob$),mousex,mousey)
endif
pause 0.1
wend
~form_dial(2,0,0,0,0,x,y,w,h)
~form_dial(3,0,0,0,0,x,y,w,h)
~FORM_DIAL(0,0,0,0,0,x,y,w,h)
~FORM_DIAL(1,0,0,0,0,x,y,w,h)
~OBJC_DRAW(VARPTR(ob$),0,-1,0,0)
SHOWPAGE
PRINT "Move the mouse and this tells you the OBJ-#:"
PRINT "click the mouse to do the form."
WHILE MOUSEK=0
IF MOUSEX<>omx OR MOUSEY<>omy
MOUSE omx,omy
PRINT OBJC_FIND(VARPTR(ob$),MOUSEX,MOUSEY)
ENDIF
PAUSE 0.1
WEND
~FORM_DIAL(2,0,0,0,0,x,y,w,h)
~FORM_DIAL(3,0,0,0,0,x,y,w,h)
vsync
~form_dial(0,0,0,0,0,x,y,w,h)
~form_dial(1,0,0,0,0,x,y,w,h)
SHOWPAGE
~FORM_DIAL(0,0,0,0,0,x,y,w,h)
~FORM_DIAL(1,0,0,0,0,x,y,w,h)
nochmal:
ret=form_do(varptr(ob$))
print "RET:";ret
if ret=2 ! OK
ret=FORM_DO(VARPTR(ob$))
PRINT "RET:";ret
IF ret=2 ! OK
gedr=-1
for i=0 to sel-1
if dpeek(varptr(ob$)+(5+i)*24+10)=1
FOR i=0 TO sel-1
IF DPEEK(VARPTR(ob$)+(5+i)*24+10)=1
gedr=i
print "You selected nr.";gedr+1;"."
endif
next i
if gedr=-1
~form_alert(1,"[3][You have not selected anything !][OH]")
dpoke varptr(ob$)+(ret)*24+10,0
goto nochmal
endif
endif
PRINT "You selected nr.";gedr+1;"."
ENDIF
NEXT i
IF gedr=-1
~FORM_ALERT(1,"[3][You have not selected anything !][OH]")
DPOKE VARPTR(ob$)+(ret)*24+10,0
GOTO nochmal
ENDIF
ENDIF
~form_dial(2,0,0,0,0,x,y,w,h)
~form_dial(3,0,0,0,0,x,y,w,h)
vsync
print "Your text input was: ",name$
quit
~FORM_DIAL(2,0,0,0,0,x,y,w,h)
~FORM_DIAL(3,0,0,0,0,x,y,w,h)
SHOWPAGE
PRINT "Your text input was: ",name$
QUIT
' Read and decode a SIGNUM2 font
' originally written in GFA-BASIC 1989
'
' Das fileformat:
' Byte 0 bis 7: "eset0001" (fuer e24 files) und "ps240001" beio P24 files
' Byte 8 bis 11: Long: Anzahl der Zeichen (normalerweise 128)
' byte 12 bis 139: ??
' Byte 140: long[anzchar] offsets
dim width(128)
f$="grotlt.e24"
f$="normande.e24"
f$="/work/CDs/ATARI-ST_v_2/st/d/chsets/amber.p24"
open "I",#1,f$
DIM width(128)
f$="amber.p24"
OPEN "I",#1,f$
d=10
clearw
seek #1,0
header$=input$(#1,140)
for i=0 to 128-1
width(i)=CVI(reverse$(input$(#1,4)))
next i
memdump varptr(header$),140
data$=input$(#1,lof(#1)-140-512)
CLEARW
SEEK #1,0
header$=INPUT$(#1,140)
FOR i=0 TO 128-1
width(i)=CVI(REVERSE$(INPUT$(#1,4)))
NEXT i
MEMDUMP VARPTR(header$),140
data$=INPUT$(#1,LOF(#1)-140-512)
wx=0
for c=1 to 63
@disp(wx,100,c)
next c
FOR c=1 TO 63
@disp(wx,100,c)
NEXT c
wx=0
for c=64 to 127
@disp(wx,200,c)
next c
keyevent
quit
FOR c=64 TO 127
@disp(wx,200,c)
NEXT c
KEYEVENT
QUIT
procedure disp(x,y,c)
local o,w,h,d
PROCEDURE disp(x,y,c)
LOCAL o,w,h,d
o=width(c)
h=(width(c+1)-o)/4
d=peek(varptr(data$)+o)
w=peek(varptr(data$)+o+1)
d=PEEK(VARPTR(data$)+o)
w=PEEK(VARPTR(data$)+o+1)
' w=peek(varptr(data$)+o+2)
text x,y+50,str$(w)
print peek(varptr(data$)+o+1),peek(varptr(data$)+o+3),w,
print "char ";c;" offs=";d
add y,d
add o,4
sub h,1
for j=0 to h-1
a=(peek(varptr(data$)+o+j*4) and 255)*256*256*256+(peek(varptr(data$)+o+1+j*4) and 255)*256*256+(peek(varptr(data$)+o+2+j*4) and 255)*256+(peek(varptr(data$)+o+3+j*4) and 255)
' a=(peek(varptr(data$)+o+0+j*4) and 255)*256+(peek(varptr(data$)+o+1+j*4) and 255)
for i=0 to 32
if btst(a,i)
plot x+15-i,y
endif
next i
inc y
next j
vsync
add wx,w
return
TEXT x,y+50,STR$(w)
PRINT PEEK(VARPTR(data$)+o+1),PEEK(VARPTR(data$)+o+3),w,
PRINT "char ";c;" offs=";d
ADD y,d
ADD o,4
SUB h,1
for j=0 to h-1
a=(PEEK(VARPTR(data$)+o+j*4) AND 255)*256*256*256+(PEEK(VARPTR(data$)+o+1+j*4) AND 255)*256*256+(PEEK(VARPTR(data$)+o+2+j*4) AND 255)*256+(PEEK(VARPTR(data$)+o+3+j*4) AND 255)
' a=(peek(varptr(data$)+o+0+j*4) and 255)*256+(peek(varptr(data$)+o+1+j*4) and 255)
FOR i=0 TO 32
IF BTST(a,i)
PLOT x+15-i,y
ENDIF
NEXT i
INC y
NEXT j
SHOWPAGE
ADD wx,w
RETURN
color get_color(65535,0,0)
pbox 0,0,640,400
color get_color(65535,65535,0)
gprint "You can use ATARI ST *.RSC-files..."
gprint "Test of the rsrc-funktions..."
' Opens Object trees from a ATARI ST resource file (*.RSC) and
' displays them. (c) Markus Hoffmann 2002
'
' Demonstrates the usage of RSRC_LOAD, GPRINT, RSRC_GADDR, FORM_CENTER
' FORM_DIAL, FORM_DO
' in X11-Basic
'
COLOR COLOR_RGB(1,0,0)
PBOX 0,0,640,400
COLOR COLOR_RGB(1,1,0)
GPRINT "You can use ATARI ST *.RSC-files..."
GPRINT "Test of the rsrc-functions..."
' v.1.11 (c) Markus Hoffmann
color get_color(0,65535,0)
COLOR COLOR_RGB(0,1,0)
for i=0 to 30
circle 320,200,i*5
next i
gprint "use the right mouse button to skip this dialog."
FOR i=0 TO 30
CIRCLE 320,200,i*5
NEXT i
GPRINT "use the right mouse button TO skip this dialog."
i=0
while len(param$(i))
inc i
wend
f$=param$(i-1)
print i,f$
if not exist(f$) or upper$(right$(f$,4))<>".RSC"
fileselect "load RSC...","./rsc/*.rsc","",f$
endif
rsrc_load f$
WHILE LEN(PARAM$(i))
INC i
WEND
f$=PARAM$(i-1)
PRINT i,f$
IF NOT EXIST(f$) OR UPPER$(RIGHT$(f$,4))<>".RSC"
FILESELECT "load RSC...","./rsc/*.rsc","",f$
ENDIF
RSRC_LOAD f$
count=0
adr=rsrc_gaddr(15,count)
while adr<>-1
t$=space$(20000)
bmove adr,varptr(t$),10000
wort_sep t$,chr$(0),0,t$,a$
print count,adr,t$
~form_alert(1,t$)
inc count
adr=rsrc_gaddr(15,count)
wend
adr=RSRC_GADDR(15,count) ! Get the address of the first Free String
WHILE adr<>-1
PRINT count,adr
t$=SPACE$(20000)
BMOVE adr,VARPTR(t$),1000
SPLIT t$,CHR$(0),0,t$,a$
PRINT count,adr,t$
~FORM_ALERT(1,t$) ! Display it as an ALERT box
INC count
adr=RSRC_GADDR(15,count) ! get the next address
WEND
count=0
adr=rsrc_gaddr(0,count)
while adr<>-1
print count,adr
print "CENTER"
~form_center(adr,x,y,w,h)
~form_dial(0,x,y,w,h,x,y,w,h)
~form_dial(1,x,y,w,h,x,y,w,h)
~objc_draw(adr,0,-1,0,0)
print form_do(adr)
~form_dial(2,x,y,w,h,x,y,w,h)
~form_dial(3,x,y,w,h,x,y,w,h)
inc count
adr=rsrc_gaddr(0,count)
wend
rsrc_free
quit
adr=RSRC_GADDR(0,count) ! Get the address of the first object tree
WHILE adr<>-1
~FORM_CENTER(adr,x,y,w,h) ! Center the tree on the screen and get its coordinates
~FORM_DIAL(0,x,y,w,h,x,y,w,h) ! save the background
~FORM_DIAL(1,x,y,w,h,x,y,w,h) !
~OBJC_DRAW(adr,0,-1,0,0) ! Draw the object tree
ret=FORM_DO(adr) ! Manage User input