Commit a2213fb3 by kollo

version 1.12-2

parent 067c4362
' WSHOW.bas is a program which calculates and draws 3 dimentional Objects
' with linear algebra (c) Markus Hoffmann 1993
'
' Original version GFA-Basic on ATARI ST
' Ported to X11-Basic
'
DIM pxU(4),pyU(4)
meldung$="WSHOW (c) Markus Hoffmann 1989 - 2001"
maxfl=20000
......@@ -61,11 +68,11 @@ lichtr=50000
lichtg=65535
lichtb=65535
'
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)
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)
dim film$(73)
while exist("bild"+str$(bildcount,3,3,1)+".xpm")
......@@ -104,8 +111,8 @@ do
sty=sin(stwink)
bbx=-cos(stwink) ! Beobachterblickrichtung
bby=-sin(stwink)
zwink=SGN(bby)*SGN(bbx)*ATN(ABS(bbx/bby))+PI*ABS(bby<0)
xwink=-SGN(bbz)*ATN(ABS(bbz/SQR(bbz^2+bby^2)))
zwink=SGN(bby)*SGN(bbx)*ATN(ABS(bbx/bby))+PI*ABS(bby<0)
xwink=-SGN(bbz)*ATN(ABS(bbz/SQR(bbz^2+bby^2)))
@sort
@plot
......@@ -167,8 +174,8 @@ procedure calc
@addfl(x,y,z,x+sx,y,zz,x+sx,y+sy,zzzz,x,y+sy,zzz)
NEXT x
NEXT y
gprint anzfl;" Flchen. in ";ctimer-t;" Sekunden."
vsync
gprint anzfl;" Flchen. in ";ctimer-t;" Sekunden."
vsync
kug:
local r,spsp,st,phi,theta,x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4
......@@ -218,8 +225,8 @@ procedure sort
adr=varptr(welt(0))
ad=8*13
t=ctimer
welt2()=welt()
adr2=varptr(welt2(0))
welt2()=welt()
adr2=varptr(welt2(0))
FOR i=0 TO anzfl-1
j=index(i)
bmove adr2+ad*j,adr+ad*i,ad
......@@ -262,40 +269,38 @@ procedure plot
color grau
pbox 0,0,640,400
color weiss
pxU(0)=@kx(x1,y2,z1/2)
pyU(0)=@ky(x1,y2,z1/2)
pxU(1)=@kx(x2,y2,z1/2)
pyU(1)=@ky(x2,y2,z1/2)
pxU(2)=@kx(x2,y2,z2/2)
pyU(2)=@ky(x2,y2,z2/2)
pxU(3)=@kx(x1,y2,z2/2)
pyU(3)=@ky(x1,y2,z2/2)
POLYFILL 4,pxU(),pyU()
color schwarz
POLYLINE 4,pxU(),pyU()
pxU(0)=@kx(x1,y2,z1/2)
pyU(0)=@ky(x1,y2,z1/2)
pxU(1)=@kx(x1,y2,z2/2)
pyU(1)=@ky(x1,y2,z2/2)
pxU(2)=@kx(x1,y1,z2/2)
pyU(2)=@ky(x1,y1,z2/2)
pxU(3)=@kx(x1,y1,z1/2)
pyU(3)=@ky(x1,y1,z1/2)
color weiss
POLYFILL 4,pxU(),pyU()
color blau
for i=z1/2 to z2/2 step (z2-z1)/12
LINE @kx(x1,y1,i),@ky(x1,y1,i),@kx(x1,y2,i),@ky(x1,y2,i)
LINE @kx(x1,y2,i),@ky(x1,y2,i),@kx(x2,y2,i),@ky(x2,y2,i)
next i
color gelb
text 20,20,"3D - Flaechengrafik mit X11-Basic (c) Markus Hoffmann"
color schwarz
LINE @kx(x1,y1,0),@ky(x1,y1,0),@kx(x1,y2,0),@ky(x1,y2,0)
LINE @kx(x1,y2,0),@ky(x1,y2,0),@kx(x2,y2,0),@ky(x2,y2,0)
POLYline 4,pxU(),pyU()
pxU(0)=@kx(x1,y2,z1/2)
pyU(0)=@ky(x1,y2,z1/2)
pxU(1)=@kx(x2,y2,z1/2)
pyU(1)=@ky(x2,y2,z1/2)
pxU(2)=@kx(x2,y2,z2/2)
pyU(2)=@ky(x2,y2,z2/2)
pxU(3)=@kx(x1,y2,z2/2)
pyU(3)=@ky(x1,y2,z2/2)
POLYFILL 4,pxU(),pyU()
color schwarz
POLYLINE 4,pxU(),pyU()
pxU(0)=@kx(x1,y2,z1/2)
pyU(0)=@ky(x1,y2,z1/2)
pxU(1)=@kx(x1,y2,z2/2)
pyU(1)=@ky(x1,y2,z2/2)
pxU(2)=@kx(x1,y1,z2/2)
pyU(2)=@ky(x1,y1,z2/2)
pxU(3)=@kx(x1,y1,z1/2)
pyU(3)=@ky(x1,y1,z1/2)
color weiss
POLYFILL 4,pxU(),pyU()
color blau
for i=z1/2 to z2/2 step (z2-z1)/12
LINE @kx(x1,y1,i),@ky(x1,y1,i),@kx(x1,y2,i),@ky(x1,y2,i)
LINE @kx(x1,y2,i),@ky(x1,y2,i),@kx(x2,y2,i),@ky(x2,y2,i)
next i
color gelb
text 20,20,"3D - Flaechengrafik mit X11-Basic (c) Markus Hoffmann"
color schwarz
LINE @kx(x1,y1,0),@ky(x1,y1,0),@kx(x1,y2,0),@ky(x1,y2,0)
LINE @kx(x1,y2,0),@ky(x1,y2,0),@kx(x2,y2,0),@ky(x2,y2,0)
POLYLINE 4,pxU(),pyU()
FOR i=0 to anzfl-1
'
......@@ -329,24 +334,21 @@ FOR i=0 to anzfl-1
pyU(2)=@ky(welt(6+13*i),welt(7+13*i),welt(8+13*i))
pxU(3)=@kx(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
vsync
@progress(anzfl,i)
ptimer=timer
endif
endif
NEXT i
@progress(anzfl,i)
vsync
print "Plotted in ";round(timer-plottime);" sec."
vsync
@progress(anzfl,i)
ptimer=timer
endif
endif
NEXT i
@progress(anzfl,i)
vsync
print "Plotted in ";round(timer-plottime);" sec."
return
'
'
'
function f(x,y)
return 0.8*EXP(-2*(x^2+y^2))*COS((x^2+y^2)*10)
return 0.8*EXP(-2*(x^2+y^2))*COS((x^2+y^2)*10)
endfunc
' Koordinatentransformationen mit Perspektive:
FUNCTION kx(x,y,z)
......
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
<HTML>
<HEAD>
<TITLE>Index of /examples/3D-graphics</TITLE>
</HEAD>
<BODY>
<H1>Index of /examples/3D-graphics</H1>
<PRE><IMG SRC="/icons/blank.gif" ALT=" "> <A HREF="?N=D">Name</A> <A HREF="?M=A">Last modified</A>
<A HREF="?S=A">Size</A> <A HREF="?D=A">Description</A>
<HR>
<IMG SRC="/icons/back.gif" ALT="[DIR]"> <A HREF="/examples/">Parent Directory</A> 11-Sep-2003 18:17 -
<IMG SRC="/icons/unknown.gif" ALT="[ ]"> <A HREF="3Dshow.bas">3Dshow.bas</A> 9k<A HREF="../screenshots/3Dshow.png">(Screenshot)</A>
</PRE><HR>
<ADDRESS>Apache/1.3.26 Server at x11-basic.sourceforge.net Port 80</ADDRESS>
</BODY></HTML>
' Beispiele, wie man mit Grafik-Objekten umgeht.
' Wer das AES vom ATARI ST kennt, dem kommt es bekannt vor...
' 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
strings$="Bitte whlen Sie aus:"+chr$(0)
strings$="Please select from given choices:"+chr$(0)
btext1$="OK"+chr$(0)
btext2$="CANCEL"+chr$(0)
x=100
......@@ -12,10 +12,10 @@ h=200
sel=9
s$=""
for i=0 to sel-1
s$=s$+str$(i+1)+chr$(0)
s$=s$+str$(i+1)+chr$(0)
next i
name$="Ichbins"+string$(30,chr$(0))
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)
......@@ -37,8 +37,8 @@ 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)
......@@ -51,9 +51,14 @@ ob$=ob$+mkl$(varptr(ted$))+mki$(10)+mki$(110)+mki$(16*10)+mki$(16)
~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
print objc_find(varptr(ob$),mousex,mousey)
pause 0.1
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)
......@@ -69,11 +74,11 @@ if ret=2 ! OK
for i=0 to sel-1
if dpeek(varptr(ob$)+(5+i)*24+10)=1
gedr=i
print "Sie hatten nr.";gedr+1;" gewaehlt."
print "You selected nr.";gedr+1;"."
endif
next i
if gedr=-1
~form_alert(1,"[3][Sie haben nix gewhlt !][OH]")
~form_alert(1,"[3][You have not selected anything !][OH]")
dpoke varptr(ob$)+(ret)*24+10,0
goto nochmal
endif
......@@ -82,5 +87,5 @@ 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 "Ihre Texteingabe war: ",name$
end
print "Your text input was: ",name$
quit
color get_color(65535,0,0)
pbox 0,0,640,400
' Test der Rsrc-Funktionen
' Es koennen ATARI ST *.RSC-Files verwendet werden...
' v.1.11
color get_color(65535,65535,0)
gprint "You can use ATARI ST *.RSC-files..."
gprint "Test of the rsrc-funktions..."
' v.1.11 (c) Markus Hoffmann
color get_color(0,65535,0)
for i=0 to 30
circle 320,200,i*5
next i
text 10,10,"Mit der rechten Maustaste geht es weiter."
fileselect "RSC-Laden","./rsc/*.rsc","",f$
gprint "use the right mouse button to skip this dialog."
fileselect "load RSC...","./rsc/*.rsc","",f$
rsrc_load f$
count=0
adr=rsrc_gaddr(15,count)
......@@ -31,6 +31,7 @@ while adr<>-1
~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)
......
......@@ -6,8 +6,9 @@
dim a(18000),b(18000)
arrayfill a(),0
arrayfill b(),0
clearw
gprint "shows ATARI ST monochrome pictures (32000 Bytes)"
fileselect "Datei auswaehlen:","pictures/*.pic","f1.pic",f$
fileselect "Select picture file ...","pictures/*.pic","f1.pic",f$
if exist(f$)
open "I",#1,f$
clr x,y,count
......@@ -41,12 +42,12 @@ endif
quit
procedure showit
for t=1 to 15
pbox 0,0,640,400
color get_color(65535,65535,10000)
scope b(),a(),1,t/10,200-200*t/10,t/10,320-320*t/10
color get_color(65535,0,65535)
scope a(),b(),1,t/10,,t/10
vsync
color get_color(0,0,10000)
pbox 0,0,640,400
next t
return
gm=0
i=1
while len(param$(i))
i0=val(param$(i))
inc i
wend
if i0=0
i0=tineget("GLOBALS[HECUR]")
gm=1
endif
alpha=5/30
t=0
dt=1/60/60
~@hochrechnung()
if gm
weiss=get_color(65535,65535,65535)
grau=get_color(65535/1.2,65535/1.2,65535/1.2)
schwarz=get_color(0,0,0)
rot=get_color(65535,0,0)
gelb=get_color(20000,65535,20000)
groesse=0.7
bw=700
bh=200
COLOR schwarz
sizew ,bw,bh
pause 1
PBOX 0,0,bw,bh
color rot
deftext ,0.05,0.05
ltext 10,100,"Run-Ende:"
do
i0=tineget("GLOBALS[HECUR]")
a=@hochrechnung()
@display(unixtime$(timer+3600*a))
pause 3
loop
endif
quit
function hochrechnung()
tau=@tau(i0)
i=i0
t=0
do
di=-i/tau*dt
add i,di
tau=@tau(i)
add t,dt
' print t;" ";i;" ";tau
if i<13
print "13 mA erreicht in ";str$(t,3,3);" Stunden, also um ";unixtime$(timer+t*3600)
return t
endif
exit if t>10
loop
endfunction
function i(t)
return i0*exp(-t/tau)
endfunction
function tau(i)
return 16-alpha*i
endfunction
procedure display(d$)
COLOR schwarz
PBOX 0,0,bw,bh
color rot
DEFLINE ,2,2
deftext ,0.05,0.07
ltext 50,2,"Run-Ende:"
DEFLINE ,25*groesse,2
DEFTEXT 1,groesse,2*groesse
color gelb
'for i=0 to 360 step 10
LTEXT bw/2+cos(i/180*pi)*10-LTEXTLEN(d$)/2,30+sin(i/180*pi)*10,d$
'next i
color weiss
LTEXT bw/2-LTEXTLEN(d$)/2,30,d$
VSYNC
return
dim enable(220)
dim herab(220)
dim transfer(10)
dim rt(220)
dim vt(220)
ntransfer=3
sollstrom=50
arrayfill enable(),0
for j=0 to 3*6-1
for i=0 to 9
enable(i+j*11)=1
herab(i+j*11)=0
next i
enable(i+j*11)=1
next j
sizew ,660,400
schwarz=get_color(0,0,0)
weiss=get_color(65535,65535,65535)
rot=get_color(65535,0,0)
gelb=get_color(65535,65535,0)
blau=get_color(0,0,65535)
for i=0 to 28*3-1
herab(i)=50
next i
do
@display
k=random(32)+20
for i=0 to ntransfer-1
transfer(i)=k
next i
@injection
if ziel=-1
print "Mit dieser Petra-Fuellung ist durch Topping up"
print "keine Verbesserung mehr zu erzielen."
print "Versuchen Sie kleinere Bunchstroeme in PETRA."
pause 100
quit
else
for i=ziel to ziel+ntransfer-1
herab(i)=herab(i)+transfer(i-ziel)
next i
endif
loop
pause 100
quit
procedure test(n)
local i,sx,sy,ss,rms
herat()=herab()
for i=n to n+ntransfer-1
herat(i)=herat(i)+transfer(i-n)
next i
sx=0
sy=0
ss=0
rms=0
for i=0 to 219
add sx,cos(i/220*2*pi)*herat(i)
add sy,sin(i/220*2*pi)*herat(i)
add rms,(herat(i)-sollstrom)^2
add ss,herat(i)
next i
rms=rms/220
if ss>0
sx=sx/ss
sy=sy/ss
endif
testrms=rms
testvec=sqrt(sx*sx+sy*sy)
return
procedure test2(n)
local i,j,sx,sy,ss,rms,trms,nb
herat()=herab()
for i=n to n+ntransfer-1
herat(i)=herat(i)+transfer(i-n)
next i
sx=0
sy=0
ss=0
rms=0
trms=0
nb=0
for i=0 to 219
add ss,herat(i)
if enable(i)
add trms,(herat(i)-sollstrom)^2
inc nb
endif
next i
for i=0 to 219
if enable(i)
add sx,herat(i)
add rms,(sx-ss/nb*i)^2
endif
next i
trms=trms/nb
rms=rms/nb
testvec=rms
testrms=trms
return
procedure test3(n)
local i,j,sx,sy,ss,rmsx,rmsy
herat()=herab()
for i=n to n+ntransfer-1
herat(i)=herat(i)+transfer(i-n)
next i
sx=0
sy=0
ss=0
rmsy=0
rmsx=0
for i=0 to 219
add ss,herat(i)
next i
for i=0 to 219
add sx,herat(i)
add sy,herat((i+110) mod 220)
add rmsx,(sx-ss/220*i)^2
add rmsy,(sy-ss/220*i)^2
next i
print rmsx,rmsy
testvec=sqrt(rmsx*rmsx+rmsy*rmsy)/220
testrms=0
return
procedure injection
nbunch=0
sx=0
sy=0
ss=0
rms=0
for i=0 to 219
if enable(i)
add sx,cos(i/220*2*pi)*herab(i)
add sy,sin(i/220*2*pi)*herab(i)
add rms,(herab(i)-sollstrom)^2
add ss,herab(i)
inc nbunch
endif
next i
rms=rms/nbunch
if ss>0
sx=sx/ss
sy=sy/ss
' print "ss=";int(100*sqrt(sx*sx+sy*sy))
testvecmin=100000000
kmin=-1
testrmsmax=0
for k=0 to 220-1-ntransfer step ntransfer
if enable(k)
@test2(k)
if testrms<rms
color gelb
pcircle k*3,250+testvec/100,3
color blau
pcircle k*3,100*(sqrt(rms)-sqrt(testrms)),2
if testvec<testvecmin
testvecmin=testvec
kmin=k
testrmsmin=testrms
endif
if testrmsmax<sqrt(rms)-sqrt(testrms)
testrmsmax=sqrt(rms)-sqrt(testrms)
endif
vsync
endif
endif
next k
ziel=kmin
else
ziel=0
endif
print "Ziel=";ziel,"RMS=";sqrt(testrmsmin);"(";sqrt(rms);")","IST:";str$(sqrt(rms)-sqrt(testrmsmin),5,5);" MAX:";str$(sqrt(testrmsmax),5,5)
return
procedure display
color schwarz
pbox 0,0,660,400
sx=0
sy=0
ss=0
color weiss
line 0,200-sollstrom,660,200-sollstrom,
for i=0 to 219
' print i,herab(i)
pbox i*3,200-herab(i),i*3+2,200
pcircle 500+100*cos(i/220*2*pi),300-100*sin(i/220*2*pi),sqrt(herab(i)/4)
add sx,cos(i/220*2*pi)*herab(i)
add sy,sin(i/220*2*pi)*herab(i)
add ss,herab(i)
if enable(i)
color rot
pcircle i*3,203,2
color weiss
endif
next i
line 500,297,500,303
line 497,300,503,300
color rot
if ss>0
sx=sx/ss
sy=sy/ss
pcircle 500+100*sx,300-100*sy,2
endif
vsync
return
Summary: Example basic program sourcefiles for X11-Basic
Vendor: Markus Hoffmann
Name: X11Basic-examples
Version: 1.11
Release: 4
Version: 1.12
Release: 5
Copyright: GPL
Group: Development/Languages
URL: http://x11-basic.sourceforge.net/examples/
......@@ -19,21 +19,6 @@ Have fun.
regards Markus Hoffmann
=======================================================================
Dies sind einige Beispielprogramme mit teils
groesserem Umfang fuer X11-Basic.
Sie sollen als Anleitung und Anregung fuer eigene
Programme dienen.
Viel Spass damit.
Markus Hoffmann
Authors:
--------
Markus Hoffmann <kollo@users.sourceforge.net>
......@@ -447,7 +447,7 @@ PROCEDURE make(x,y)
RETURN
PROCEDURE explode(a,x,y)
IF sound
WAVE -7,3,2,20000
' WAVE -7,3,2,20000
ENDIF
feld(x,y)=0
@make(x,y)
......
......@@ -69,6 +69,22 @@ DO
omarx=marx
omary=mary
pause 0.05
' Finde die drunterliegenden Map_elemente
for i=0 to anzpoly-1
t$=polygon$(i)
l1=cvf(mid$(t$,7,4))
l2=cvf(mid$(t$,11,4))
l3=cvf(mid$(t$,15,4))
l4=cvf(mid$(t$,19,4))
if marx>l1 and marx<l2 and mary>l3 and mary<l4
anz=cvi(mid$(t$,23,2))
name$=mid$(t$,25+anz*8,len(t$)-25-anz*8)
name$=replace$(name$,chr$(0),"")
if @inpoly(t$,marx,mary)
print i,name$
endif
endif
next i
menu
mouse mx,my,mk
if mk
......@@ -745,7 +761,7 @@ procedure exportwp
cc$=mid$(t$,49,2)
displ=asc(mid$(t$,5,1))
subclass$=hex$(cvi(mid$(t$,9,2)),4,4,1)+hex$(cvl(mid$(t$,11,4)),8,8,1)+hex$(cvl(mid$(t$,15,4)),8,8,1)+hex$(cvl(mid$(t$,19,4)),8,8,1)+hex$(cvl(mid$(t$,23,4)),8,8,1)
print #2," Name=";chr$(34);n$;chr$(34);space$(max(6,len(n$))-len(n$));
print #2," Name=";chr$(34);name$;chr$(34);space$(max(6,len(n$))-len(n$));
print #2," Symbl=0x";hex$(CVI(mid$(t$,7,2)),4,4,1);
print #2," X=";x;" Y=";y;
if alt<9e24
......@@ -804,6 +820,34 @@ procedure exportwp
~form_alert(1,"[3][Keine Wegpunkte vorhanden!][ OH ]")
endif
return
function inpoly(t$,x,y)
local l1,l2,l3,l4,anz,i,j,xpi,xpj,ypi,ypj,c
c=0
' l1=cvf(mid$(t$,7,4))
' l2=cvf(mid$(t$,11,4))
' l3=cvf(mid$(t$,15,4))
' l4=cvf(mid$(t$,19,4))
anz=cvi(mid$(t$,23,2))
i=0
j=anz-1
while i<anz
xpi=cvf(mid$(t$,25+8*i,4))
xpj=cvf(mid$(t$,25+8*j,4))
ypi=cvf(mid$(t$,25+8*i+4,4))
ypj=cvf(mid$(t$,25+8*j+4,4))
if ((ypi<=y and y<ypj) or (ypj<=y and y<ypi))
if (x<(xpj-xpi)*(y-ypi)/(ypj-ypi)+xpi)
c=(not c)
endif
endif
j=i
inc i
wend
return c
endfunction
procedure exportmap
local ers,f$,i,j,t$,typ,flags,alt,l1,l2,l3,l4,anz,name$
ers=2
......
......@@ -9,4 +9,6 @@
488 Mar 7 22:28 <a href="index.html">index.html</a>
1271 Feb 15 2003 <a href="internet-dial">internet-dial</a>
238 Apr 12 2000 <a href="iserver.bas">iserver.bas</a>
586 Okt 17 21:36 <a href="udp_receive.bas">udp_receive.bas</a>
752 Okt 15 14:46 <a href="udp_send.bas">udp_send.bas</a>
</pre></body></html>
' KLeiner Internetserver auf Port 5555
open "US",#1,"",5000
open "US",#1,"",5005
do
open "UA",#2,"",1
print #2,"Welcome..."
flush #2
for t=0 to 20
lineinput #2,t$
print "got: "+t$
next t
print #2,"Welcome to X11-Basic test-server ..."
flush #2
t$=""
do
if inp?(#2)
lineinput #2,t$
print "got: ";t$
endif
t$=upper$(left$(t$,4))
exit if t$="QUIT"
exit if t$="SHUT"
loop
print #2,"goodbye..."
flush #2
close #2
exit if left$(t$,4)="quit"
exit if t$="SHUT"
loop
close
quit
open "UU",#1,"listener",5555
' open "UU",#2,"sender",5556
do
t$=@getmessage$()
if len(t$)
a=cvi(left$(t$,2))
print "received: ";right$(t$,len(t$)-2)
endif