Commit 1cb182ce by kollo

version 1.15-1 (14.2 ?)

parent c673839b
Summary: Example basic program sourcefiles for X11-Basic
Vendor: Markus Hoffmann
Name: X11Basic-examples
Version: 1.12
Release: 5
Version: 1.14
Release: 2
Copyright: GPL
Group: Development/Languages
URL: http://x11-basic.sourceforge.net/examples/
......@@ -11,9 +11,7 @@ Packager: Markus Hoffmann <kollo@users.sourceforge.net>
%description
Thease are example programs for X11-Basic. Some are not completed so far and
will not work correctly. This is not because of bugs of the interpreter
itself.
Thease are example programs for X11-Basic.
Have fun.
......
......@@ -1765,7 +1765,7 @@ procedure hoehenprofil
print #11,"set y2label "+chr$(34)+"Geschwindigkeit [km/h]"+chr$(34)
print #11,"set origin 0,0"
print #11,"set size 1,0.5"
print #11,"plot [:][-10:200] "+chr$(34)+dattmp$+chr$(34)+" u ($2/1000):4 t ";
print #11,"plot [:][-10:3000] "+chr$(34)+dattmp$+chr$(34)+" u ($2/1000):4 t ";
print #11,chr$(34)+"Hoehe"+chr$(34)+" w steps , ";
print #11,chr$(34)+dattmp$+chr$(34)+" u ($2/1000):($5) t ";
print #11,chr$(34)+"Geschwindigkeit"+chr$(34)+" w steps"
......
' creates ov2 files from ascii input
' (c) Markus Hoffmann 2008
'
' written in X11-basic
'
' Version 1.02 now does the map-Patitioning (new optimized algorithm)
' The algorithm is not yet heavily tested. (c) Markus Hoffmann
' latest modification 27.03.2008
'
dim skipper(200)
maxpoiinarea=16
minpoiinarea=maxpoiinarea/4
maxlevel=0
i=1
outputfilename$="a.ov2"
sizew ,700,700
WHILE LEN(PARAM$(i))
IF LEFT$(PARAM$(i))="-"
IF PARAM$(i)="--help" OR PARAM$(i)="-h"
@intro
@using
ELSE IF PARAM$(i)="--version"
@intro
QUIT
ELSE IF PARAM$(i)="-o"
INC i
IF LEN(PARAM$(i))
outputfilename$=PARAM$(i)
ENDIF
ENDIF
ELSE
inputfile$=param$(i)
if not exist(inputfile$)
print "a2ov2: "+inputfile$+": file or path not found"
clr inputfile$
ENDIF
ENDIF
INC i
WEND
if len(inputfile$)
if exist(outputfilename$)
print "a2ov2: Outputfilename already exists: ";outputfilename$
else
@convert
endif
else
print "a2ov2: No input files"
endif
quit
procedure intro
print "ASCII POINT OF INTEREST to ov2 file Converter V.1.10 (c) Markus Hoffmann 2008-2008"
version
return
procedure using
print "Usage: a2ov2 [options] file..."
print "Options:"
print " -h, --help Display this information"
print " -o <file> Place the output into <file>"
return
procedure convert
local t$
anzzeilen=0
print "PASS 0"
open "I",#1,inputfile$
while not eof(#1)
lineinput #1,t$
t$=xtrim$(t$)
if len(t$)
if left$(t$)<>"#"
inc anzzeilen
endif
endif
wend
close #1
dim zeilen$(anzzeilen)
print "PASS 1"
anzzeilen=0
open "I",#1,inputfile$
while not eof(#1)
lineinput #1,t$
t$=xtrim$(t$)
if len(t$)
if left$(t$)<>"#"
zeilen$(anzzeilen)=t$
pointarray$=pointarray$+mkl$(anzzeilen)
inc anzzeilen
endif
endif
wend
close #1
print "PASS 2"
open "O",#2,outputfilename$
@doit(pointarray$)
close #2
print poicount;" POIs in ";areacount;" areas."
print "Deepest level: ";maxlevel
return
procedure doit(array$)
local area$,area1$,area2$,area3$,area4$
local ar1$,ar2$,ar3$,ar4$
local x1,x2,y1,y2
if len(array$)/4<=minpoiinarea
@writepois(array$)
else
area$=@makearea$(array$)
x1=cvl(mid$(area$,0*4+1,4))
y1=cvl(mid$(area$,1*4+1,4))
x2=cvl(mid$(area$,2*4+1,4))
y2=cvl(mid$(area$,3*4+1,4))
if x2-x1>3 and y2-y1>3
@openskipper(area$)
' print x1/100000,y1/100000,x2/100000,y2/100000
area1$=mkl$(x1)+mkl$(y1)+mkl$((x2-x1)/2+x1)+mkl$((y2-y1)/2+y1)
area2$=mkl$((x2-x1)/2+x1)+mkl$(y1)+mkl$(x2)+mkl$((y2-y1)/2+y1)
area3$=mkl$(x1)+mkl$((y2-y1)/2+y1)+mkl$((x2-x1)/2+x1)+mkl$(y2)
area4$=mkl$((x2-x1)/2+x1)+mkl$((y2-y1)/2+y1)+mkl$(x2)+mkl$(y2)
ar1$=@selectpois$(area1$,array$)
ar2$=@selectpois$(area2$,array$)
ar3$=@selectpois$(area3$,array$)
ar4$=@selectpois$(area4$,array$)
@doit(ar1$)
@doit(ar2$)
@doit(ar3$)
@doit(ar4$)
@closeskipper
else
print "Something is wrong: ";len(array$)/4;" identical points?"
@writepois(array$)
stop
endif
endif
return
procedure openskipper(a$)
print "{"
skipper(level)=LOC(#2)
inc level
maxlevel=max(maxlevel,level)
inc areacount
print #2,chr$(1);mkl$(0xdeadface);right$(a$,8);left$(a$,8);
return
procedure closeskipper
dec level
tt=loc(#2)
seek #2,skipper(level)+1
print #2,mkl$(tt-loc(#2)+1);
seek #2,tt
print space$(level*2);"}"
return
function selectpois$(aa$,idx$)
local oo$,x1,x2,y1,y2,i,t$,typ,x,y,j
' print "SELECTPOIS-";
oo$=""
x1=cvl(mid$(aa$,0*4+1,4))
y1=cvl(mid$(aa$,1*4+1,4))
x2=cvl(mid$(aa$,2*4+1,4))
y2=cvl(mid$(aa$,3*4+1,4))
' print x1/100000,y1/100000,x2/100000,y2/100000
for i=0 to len(idx$)/4-1
j=cvl(mid$(idx$,i*4+1,4))
t$=zeilen$(j)
typ=val(@getval$(t$,"TYP"))
if typ=2
x=round(val(@getval$(t$,"X"))*100000) ! there is a strange roundoff error without round...
y=round(val(@getval$(t$,"Y"))*100000)
if x>=x1 and x<x2 and y>=y1 and y<y2
oo$=oo$+mkl$(j)
endif
else
print "skipped typ=";typ
endif
next i
' print len(oo$)/4;" ";
return oo$
endfunction
procedure writepois(idx$)
local i,t$,j
if len(idx$)/4
print space$(level*2);"WRITEPOIS ";len(idx$)/4
for i=0 to len(idx$)/4-1
j=cvl(mid$(idx$,i*4+1,4))
' print i,j
t$=zeilen$(j)
@processline(t$)
next i
endif
return
function makearea$(idx$)
local a$,i,xmin,xmay,ymin,ymax,t$,x,y,j
print space$(level*2);"MAKEAREA ";
xmin=360*100000
ymin=360*100000
xmax=-360*100000
ymax=-360*100000
for i=0 to len(idx$)/4-1
j=cvl(mid$(idx$,i*4+1,4))
t$=zeilen$(j)
typ=val(@getval$(t$,"TYP"))
if typ=2
x=round(val(@getval$(t$,"X"))*100000) ! there is a strange roundoff error without round...
y=round(val(@getval$(t$,"Y"))*100000)
' print x,y
xmin=min(xmin,x)
ymin=min(ymin,y)
xmax=max(xmax,x)
ymax=max(ymax,y)
else
print "skipped typ=";typ
endif
next i
add xmax,1
add ymax,1
sub xmin,1
sub ymin,1
a$=mkl$(xmin)+mkl$(ymin)+mkl$(xmax)+mkl$(ymax)
' print xmin,ymin,xmax,ymax
box (xmin-500000)/2000,(ymin-4600000)/2000,(xmax-500000)/2000,(ymax-4600000)/2000
vsync
return a$
endfunction
procedure processline(t$)
record$=""
typ=val(@getval$(t$,"TYP"))
if typ=2 or typ=0
x=round(val(@getval$(t$,"X"))*100000) ! there is a strange roundoff error without round...
y=round(val(@getval$(t$,"Y"))*100000)
name$=@getval$(t$,"NAME")
if left$(name$)=chr$(34) and right$(name$)=chr$(34)
name$=right$(name$,len(name$)-1)
name$=left$(name$,len(name$)-1)
endif
name$=name$+chr$(0)
record$=chr$(typ)+mkl$(len(name$)+5+8)+mkl$(x)+mkl$(y)+name$
inc poicount
else if typ=1
print "Error, this file cannot be processed!"
quit
else
data$=@getval$(t$,"DATA")
if left$(data$)=chr$(34) and right$(data$)=chr$(34)
data$=right$(data$,len(data$)-1)
data$=left$(data$,len(data$)-1)
endif
data$=xtrim$(data$)
while len(data$)
wort_sep data$," ",0,a$,data$
record$=record$+chr$(val("0x"+a$))
wend
record$=chr$(typ)+mkl$(len(record$)+5)+record$
endif
print #2,record$;
inc recordcount
return
function getval$(t$,f$)
local a$,val$
val$=""
wort_sep t$," ",1,a$,t$
while len(a$)
a$=trim$(a$)
wort_sep a$,"=",1,name$,val$
exit if upper$(name$)=upper$(f$)
val$=""
wort_sep t$," ",1,a$,t$
wend
return val$
endfunction
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment