Commit 4206f5fd authored by kollo's avatar kollo

version 1.22 (unvollstaendig)

parent 3f0ea8b4
...@@ -5,13 +5,14 @@ ...@@ -5,13 +5,14 @@
' Ported to X11-Basic ' Ported to X11-Basic
' '
' latest modified: 2011-08-10 for X11-Basic V.1.18 ' 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) DIM pxU(4),pyU(4)
if SENSOR?>0 ! is probably an Android device IF SENSOR?>0 ! is probably an Android device
imgpath$="/storage/tmp/" imgpath$="/storage/tmp/"
else ELSE
imgpath$="/tmp/" imgpath$="/tmp/"
endif ENDIF
meldung$="WSHOW (c) Markus Hoffmann 1989 - 2001" meldung$="WSHOW (c) Markus Hoffmann 1989 - 2001"
maxfl=80000 maxfl=80000
sortstart=0 sortstart=0
...@@ -25,19 +26,19 @@ DIM dist(maxfl) ...@@ -25,19 +26,19 @@ DIM dist(maxfl)
DIM index%(maxfl) DIM index%(maxfl)
' '
' '
weiss=GET_COLOR(65535,65535,65535) weiss=COLOR_RGB(1,1,1)
schwarz=GET_COLOR(0,0,0) schwarz=COLOR_RGB(0,0,0)
grau=GET_COLOR(32000,32000,32000) grau=COLOR_RGB(0.5,0.5,0.5)
gelb=GET_COLOR(65535,65535,32000) gelb=COLOR_RGB(1,1,0.5)
blau=GET_COLOR(32000,32000,65535) blau=COLOR_RGB(0.5,0.5,1)
rot=GET_COLOR(32000,0,0) rot=COLOR_RGB(0.5,0,0)
bildcount=1 bildcount=1
bx%=0 bx%=0
by%=0 by%=0
bw%=600 bw%=600
bh%=400 bh%=400
get_geometry 1,bx%,by%,bw%,bh% GET_GEOMETRY 1,bx%,by%,bw%,bh%
CLIP bx%,by%,bw%,bh% CLIP bx%,by%,bw%,bh%
' Koordinaten: ' Koordinaten:
' '
...@@ -91,7 +92,7 @@ WHILE EXIST(imgpath$+"bild"+STR$(bildcount,3,3,1)+".xpm") ...@@ -91,7 +92,7 @@ WHILE EXIST(imgpath$+"bild"+STR$(bildcount,3,3,1)+".xpm")
BGET #1,VARPTR(t$),LEN(t$) BGET #1,VARPTR(t$),LEN(t$)
CLOSE #1 CLOSE #1
PUT 0,0,t$ PUT 0,0,t$
VSYNC SHOWPAGE
PAUSE 0.01 PAUSE 0.01
film$(bildcount)=t$ film$(bildcount)=t$
INC bildcount INC bildcount
...@@ -102,7 +103,7 @@ IF bildcount>=72 ...@@ -102,7 +103,7 @@ IF bildcount>=72
DO DO
FOR i=0 TO bildcount-1 FOR i=0 TO bildcount-1
PUT 0,0,film$(i) PUT 0,0,film$(i)
VSYNC SHOWPAGE
PAUSE 0.02 PAUSE 0.02
NEXT i NEXT i
LOOP LOOP
...@@ -140,7 +141,7 @@ DO ...@@ -140,7 +141,7 @@ DO
COLOR gelb COLOR gelb
PBOX 400,170,400+sortzeit*50,178 PBOX 400,170,400+sortzeit*50,178
PBOX 400,190,400+plotzeit*20,198 PBOX 400,190,400+plotzeit*20,198
VSYNC SHOWPAGE
SAVEWINDOW imgpath$+"bild"+STR$(bildcount,3,3,1)+".xpm" SAVEWINDOW imgpath$+"bild"+STR$(bildcount,3,3,1)+".xpm"
INC bildcount INC bildcount
EXIT IF stwink>2*pi EXIT IF stwink>2*pi
...@@ -187,7 +188,7 @@ RETURN ...@@ -187,7 +188,7 @@ RETURN
PROCEDURE calc PROCEDURE calc
LOCAL z,zz,zzz,x,y,x,yy,t LOCAL z,zz,zzz,x,y,x,yy,t
PRINT "calculate surfaces ..." PRINT "calculate surfaces ..."
VSYNC SHOWPAGE
t=CTIMER t=CTIMER
' goto kug ' goto kug
FOR y=y2 DOWNTO y1 STEP sy FOR y=y2 DOWNTO y1 STEP sy
...@@ -201,7 +202,7 @@ PROCEDURE calc ...@@ -201,7 +202,7 @@ PROCEDURE calc
NEXT x NEXT x
NEXT y NEXT y
PRINT anzfl;" elements in ";CTIMER-t;" Sekunden." PRINT anzfl;" elements in ";CTIMER-t;" Sekunden."
VSYNC SHOWPAGE
kug: kug:
LOCAL r,spsp,st,phi,theta,x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4 LOCAL r,spsp,st,phi,theta,x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4
...@@ -224,7 +225,7 @@ kug: ...@@ -224,7 +225,7 @@ kug:
torus: torus:
GPRINT anzfl;" Flchen. in ";CTIMER-t;" Sekunden." GPRINT anzfl;" Flchen. in ";CTIMER-t;" Sekunden."
VSYNC SHOWPAGE
RETURN RETURN
PROCEDURE sort PROCEDURE sort
...@@ -259,7 +260,7 @@ PROCEDURE sort ...@@ -259,7 +260,7 @@ PROCEDURE sort
@progress(anzfl,i) @progress(anzfl,i)
print print
PRINT "in ";ctimer-t;" Sekunden." PRINT "in ";ctimer-t;" Sekunden."
VSYNC SHOWPAGE
RETURN RETURN
PROCEDURE save PROCEDURE save
OPEN "O",#1,imgpath$+"welt.xxx" OPEN "O",#1,imgpath$+"welt.xxx"
...@@ -279,7 +280,7 @@ PROCEDURE load ...@@ -279,7 +280,7 @@ PROCEDURE load
PRINT meldung$ PRINT meldung$
BGET #1,VARPTR(welt(0)),anzfl*8*13 BGET #1,VARPTR(welt(0)),anzfl*8*13
CLOSE #1 CLOSE #1
VSYNC SHOWPAGE
RETURN RETURN
PROCEDURE plot PROCEDURE plot
plottime=TIMER plottime=TIMER
...@@ -355,14 +356,14 @@ PROCEDURE plot ...@@ -355,14 +356,14 @@ PROCEDURE plot
pyU(3)=@ky(welt(9+13*i),welt(10+13*i),welt(11+13*i)) pyU(3)=@ky(welt(9+13*i),welt(10+13*i),welt(11+13*i))
POLYFILL 4,pxU(),pyU() POLYFILL 4,pxU(),pyU()
IF TIMER-ptimer>1 IF TIMER-ptimer>1
VSYNC SHOWPAGE
@progress(anzfl,i) @progress(anzfl,i)
ptimer=TIMER ptimer=TIMER
ENDIF ENDIF
ENDIF ENDIF
NEXT i NEXT i
@progress(anzfl,i) @progress(anzfl,i)
VSYNC SHOWPAGE
PRINT "Plotted in ";ROUND(TIMER-plottime);" sec." PRINT "Plotted in ";ROUND(TIMER-plottime);" sec."
RETURN RETURN
' '
...@@ -425,5 +426,5 @@ FUNCTION ky(x,y,z) ...@@ -425,5 +426,5 @@ FUNCTION ky(x,y,z)
ENDFUNC ENDFUNC
procedure progress(a,b) procedure progress(a,b)
PRINT chr$(13);"[";string$(b/a*32,"-");">";string$((1.03-b/a)*32,"-");"| ";str$(int(b/a*100),3,3);"% ]"; PRINT chr$(13);"[";string$(b/a*32,"-");">";string$((1.03-b/a)*32,"-");"| ";str$(int(b/a*100),3,3);"% ]";
flush FLUSH
RETURN RETURN
...@@ -7,8 +7,9 @@ ...@@ -7,8 +7,9 @@
<H1>Index of /examples/3D-graphics</H1> <H1>Index of /examples/3D-graphics</H1>
<HR> <HR>
<pre> <pre>
<A HREF="../">Parent Directory</A> <A HREF="../">Parent Directory</A>
<A HREF="3Dshow.bas">3Dshow.bas</A> 9k<A HREF="../../screenshots/3Dshow.png">(Screenshot)</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> </PRE><HR>
</BODY></HTML> </BODY></HTML>
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
' It then can be displayed with 3Dshow.bas ' It then can be displayed with 3Dshow.bas
' (c) Markus Hoffmann 1990 ' (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) meldung$="Surfaces of two hollow Balls"+chr$(0)
maxworld%=10000 maxworld%=10000
mf%=maxworld%*13*8 mf%=maxworld%*13*8
...@@ -36,7 +36,7 @@ st=PI/15 ...@@ -36,7 +36,7 @@ st=PI/15
FOR phi=0 TO 2*PI STEP spsp FOR phi=0 TO 2*PI STEP spsp
FOR theta=0.05 TO PI STEP st FOR theta=0.05 TO PI STEP st
PRINT chr$(13);"Flchen:"'anzworld%; PRINT chr$(13);"Flchen:"'anzworld%;
flush FLUSH
@polar1(r,theta,phi) @polar1(r,theta,phi)
@polar2(r,theta+st,phi) @polar2(r,theta+st,phi)
@polar3(r,theta+st,phi+spsp) @polar3(r,theta+st,phi+spsp)
...@@ -59,7 +59,7 @@ FOR phi=0 TO 2*PI STEP 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) @add4fl(16,x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4)
NEXT theta NEXT theta
NEXT phi NEXT phi
print PRINT
' '
PRINT "Welt: ";anzworld%;" Elemente..." PRINT "Welt: ";anzworld%;" Elemente..."
@saveworld @saveworld
...@@ -119,5 +119,5 @@ RETURN ...@@ -119,5 +119,5 @@ RETURN
' '
PROCEDURE ende PROCEDURE ende
FREE world% FREE world%
quit QUIT
RETURN 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/* ")
This diff is collapsed.
' Displays Atari-ST 8*16 fixed Fonts (c) Markus Hoffmann ' Displays Atari-ST 8*16 fixed Fonts (c) Markus Hoffmann 2004-04-12
scale=2 '
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 " 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 "load FONT","./*.fnt","",f$
FILESELECT "FONT-Laden","./*.fnt","",f$
IF LEN(f$) IF LEN(f$)
IF EXIST(f$) IF EXIST(f$)
OPEN "I",#1,f$ OPEN "I",#1,f$
...@@ -17,18 +21,16 @@ IF LEN(f$) ...@@ -17,18 +21,16 @@ IF LEN(f$)
ENDIF ENDIF
@text(text$) @text(text$)
ENDIF ENDIF
END
PAUSE 10
QUIT
PROCEDURE text(t$) PROCEDURE text(t$)
LOCAL i LOCAL i
FOR i=0 TO LEN(t$)-1 FOR i=0 TO LEN(t$)-1
char=PEEK(VARPTR(t$)+i) AND 255 char=PEEK(VARPTR(t$)+i) AND 255
@char(x,y,char) @char(x,y,char)
VSYNC SHOWPAGE
PAUSE 0.1 PAUSE 0.1
ADD x,8*scale ADD x,8*scale
IF x>=640 IF x>=bw% or char=31 or x>=8*scale*32
x=0 x=0
ADD y,16*scale ADD y,16*scale
ENDIF ENDIF
......
dim width(128) ' Read and decode a SIGNUM2 font
' originally written in GFA-BASIC 1989
'
DIM width(128)
f$="grotlt.e24" f$="grotlt.e24"
f$="normande.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 d=10
clearw CLEARW
seek #1,0 SEEK #1,0
header$=input$(#1,140) header$=INPUT$(#1,140)
for i=0 to 128-1 FOR i=0 TO 128-1
width(i)=CVI(reverse$(input$(#1,4))) width(i)=CVI(REVERSE$(INPUT$(#1,4)))
next i NEXT i
memdump varptr(header$),140 MEMDUMP VARPTR(header$),140
data$=input$(#1,lof(#1)-140-512) data$=INPUT$(#1,LOF(#1)-140-512)
wx=0 wx=0
for c=1 to 63 FOR c=1 TO 63
@disp(wx,100,c) @disp(wx,100,c)
next c NEXT c
wx=0 wx=0
for c=64 to 127 FOR c=64 TO 127
@disp(wx,200,c) @disp(wx,200,c)
next c NEXT c
keyevent KEYEVENT
quit QUIT
procedure disp(x,y,c) PROCEDURE disp(x,y,c)
local o,w,h,d LOCAL o,w,h,d
o=width(c) o=width(c)
h=(width(c+1)-o)/2 h=(width(c+1)-o)/2
d=peek(varptr(data$)+o) d=PEEK(VARPTR(data$)+o)
w=peek(varptr(data$)+o+1) w=PEEK(VARPTR(data$)+o+1)
w=peek(varptr(data$)+o+2) w=PEEK(VARPTR(data$)+o+2)
text x,y+50,str$(w) TEXT x,y+50,STR$(w)
print peek(varptr(data$)+o+1),peek(varptr(data$)+o+3),w PRINT PEEK(VARPTR(data$)+o+1),PEEK(VARPTR(data$)+o+3),w
print "char ";c;" offs=";d PRINT "char ";c;" offs=";d
add y,d ADD y,d
add o,4 ADD o,4
sub h,2 SUB h,2
for j=0 to h-1 for j=0 to h-1
a=peek(varptr(data$)+o+j*2)*256+(peek(varptr(data$)+o+1+j*2) and 255) a=PEEK(VARPTR(data$)+o+j*2)*256+(PEEK(VARPTR(data$)+o+1+j*2) AND 255)
for i=0 to 15 FOR i=0 TO 15
if btst(a,i) IF BTST(a,i)
plot x+15-i,y PLOT x+15-i,y
endif ENDIF
next i NEXT i
inc y INC y
next j NEXT j
vsync SHOWPAGE
add wx,w ADD wx,w
return 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 ' Example program how to use the GUI objects. All who are familiar with the
' GEM AES definitions of ATARI ST will find it similar. ' 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) strings$="Please select from given choices:"+CHR$(0)
btext1$="OK"+chr$(0) btext1$="OK"+CHR$(0)
btext2$="CANCEL"+chr$(0) btext2$="CANCEL"+CHR$(0)
x=100 x=100
y=100 y=100
w=320 w=320
h=200 h=200
sel=9 sel=9
s$="" s$=""
for i=0 to sel-1 FOR i=0 TO sel-1
s$=s$+str$(i+1)+chr$(0) s$=s$+STR$(i+1)+CHR$(0)
next i NEXT i
name$="Itsme"+string$(30,chr$(0)) name$="Itsme"+string$(30,CHR$(0))
buf$=space$(20)+chr$(0) buf$=SPACE$(20)+CHR$(0)
ted$=mkl$(varptr(name$))+mkl$(varptr(buf$))+mkl$(varptr(buf$)) 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) 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$=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$+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$+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$+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$+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$+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$+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$+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$+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$+MKL$(-1)+MKI$(50)+MKI$(50)+MKI$(200)+MKI$(50)
for i=0 to sel-2 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$+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$+MKL$(VARPTR(s$)+2*i)+MKI$(10+i*20)+MKI$(16)+MKI$(16)+MKI$(16)
next i next i
ob$=ob$+mki$(4)+mki$(-1)+mki$(-1)+mki$(26)+mki$(1 or 16)+mki$(0) 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$+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$+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$+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(0,0,0,0,0,x,y,w,h)
~form_dial(1,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) ~OBJC_DRAW(VARPTR(ob$),0,-1,0,0)
vsync SHOWPAGE
print "Move the mouse and this tells you the OBJ-#:" PRINT "Move the mouse and this tells you the OBJ-#:"
print "click the mouse to do the form." PRINT "click the mouse to do the form."
while mousek=0 WHILE MOUSEK=0
if mousex<>omx or mousey<>omy IF MOUSEX<>omx OR MOUSEY<>omy
mouse omx,omy MOUSE omx,omy
print objc_find(varptr(ob$),mousex,mousey) PRINT OBJC_FIND(VARPTR(ob$),MOUSEX,MOUSEY)
endif ENDIF
pause 0.1 PAUSE 0.1
wend WEND
~form_dial(2,0,0,0,0,x,y,w,h) ~FORM_DIAL(2,0,0,0,0,x,y,w,h)
~form_dial(3,0,0,0,0,x,y,w,h) ~FORM_DIAL(3,0,0,0,0,x,y,w,h)
vsync SHOWPAGE
~form_dial(0,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) ~FORM_DIAL(1,0,0,0,0,x,y,w,h)
nochmal: nochmal:
ret=form_do(varptr(ob$)) ret=FORM_DO(VARPTR(ob$))
print "RET:";ret PRINT "RET:";ret
if ret=2 ! OK IF ret=2 ! OK
gedr=-1 gedr=-1
for i=0 to sel-1 FOR i=0 TO sel-1
if dpeek(varptr(ob$)+(5+i)*24+10)=1 IF DPEEK(VARPTR(ob$)+(5+i)*24+10)=1
gedr=i gedr=i
print "You selected nr.";gedr+1;"." PRINT "You selected nr.";gedr+1;"."
endif ENDIF
next i NEXT i
if gedr=-1 IF gedr=-1
~form_alert(1,"[3][You have not selected anything !][OH]") ~FORM_ALERT(1,"[3][You have not selected anything !][OH]")
dpoke varptr(ob$)+(ret)*24+10,0 DPOKE VARPTR(ob$)+(ret)*24+10,0
goto nochmal GOTO nochmal
endif ENDIF
endif ENDIF
~form_dial(2,0,0,0,0,x,y,w,h) ~FORM_DIAL(2,0,0,0,0,x,y,w,h)
~form_dial(3,0,0,0,0,x,y,w,h) ~FORM_DIAL(3,0,0,0,0,x,y,w,h)
vsync SHOWPAGE
print "Your text input was: ",name$ PRINT "Your text input was: ",name$
quit QUIT
' Read and decode a SIGNUM2 font
' originally written in GFA-BASIC 1989
'
' Das fileformat: ' Das fileformat:
' Byte 0 bis 7: "eset0001" (fuer e24 files) und "ps240001" beio P24 files ' Byte 0 bis 7: "eset0001" (fuer e24 files) und "ps240001" beio P24 files
' Byte 8 bis 11: Long: Anzahl der Zeichen (normalerweise 128) ' Byte 8 bis 11: Long: Anzahl der Zeichen (normalerweise 128)
' byte 12 bis 139: ?? ' byte 12 bis 139: ??
' Byte 140: long[anzchar] offsets ' Byte 140: long[anzchar] offsets
DIM width(128)
dim width(128) f$="amber.p24"
f$="grotlt.e24" OPEN "I",#1,f$
f$="normande.e24"
f$="/work/CDs/ATARI-ST_v_2/st/d/chsets/amber.p24"
open "I",#1,f$
d=10 d=10
clearw CLEARW
seek #1,0 SEEK #1,0
header$=input$(#1,140) header$=INPUT$(#1,140)
for i=0 to 128-1 FOR i=0 TO 128-1
width(i)=CVI(reverse$(input$(#1,4))) width(i)=CVI(REVERSE$(INPUT$(#1,4)))
next i NEXT i
memdump varptr(header$),140 MEMDUMP VARPTR(header$),140
data$=input$(#1,lof(#1)-140-512) data$=INPUT$(#1,LOF(#1)-140-512)
wx=0 wx=0
for c=1 to 63 FOR c=1 TO 63
@disp(wx,100,c) @disp(wx,100,c)
next c NEXT c
wx=0 wx=0
for c=64 to 127 FOR c=64 TO 127
@disp(wx,200,c) @disp(wx,200,c)
next c NEXT c
keyevent KEYEVENT
quit QUIT
procedure disp(x,y,c) PROCEDURE disp(x,y,c)
local o,w,h,d LOCAL o,w,h,d
o=width(c) o=width(c)
h=(width(c+1)-o)/4