Commit 3efe11cc by kollo

update in basformat.bas and further cosmetic updates....

parent b7fe039f
......@@ -43,7 +43,7 @@ DO ! ENGINE
QUIT
ENDIF
' MOVEMENT
IF k$="q" OR k$=chr$(27)
IF k$="q" OR k$=CHR$(27)
ALERT 1,"Do you want to Quit?||",1,"YES|NO",a%
IF a%=1
QUIT
......@@ -199,13 +199,13 @@ PROCEDURE mazegen
ELSE
COLOR gelb
ENDIF
BOX 4*(cc mod mw%),4*(cc div mw%),4*(cc mod mw%)+3,4*(cc div mw%)+3
BOX 4*(cc MOD mw%),4*(cc DIV mw%),4*(cc MOD mw%)+3,4*(cc DIV mw%)+3
SHOWPAGE
IF NN>0
O=OF(NB(INT(RANDOM(NN+1))))
IF cc+o>0 AND cc+o<len(m$)
POKE VARPTR(M$)+CC+O,ASC("0")
LINE 4*(cc mod mw%)+2,4*(cc div mw%)+2,4*((cc+o) mod mw%)+2,4*((cc+o) div mw%)+2
LINE 4*(cc MOD mw%)+2,4*(cc DIV mw%)+2,4*((cc+o) MOD mw%)+2,4*((cc+o) DIV mw%)+2
ENDIF
IF cc+o*2>0 AND cc+o*2<len(m$)
POKE VARPTR(M$)+CC+O*2,ASC("0")
......@@ -220,7 +220,7 @@ PROCEDURE mazegen
ENDIF
IF STK$<>""
CC=CVL(STK$)
STK$=right$(STK$,len(STK$)-4)
STK$=RIGHT$(STK$,LEN(STK$)-4)
GOTO 340
ENDIF
FOR N=0 TO LEN(M$)-1
......
......@@ -437,6 +437,6 @@ FUNCTION ky(x,y,z)
RETURN by%+bh%/2-py*bh%/(z2-z1)
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);"% ]";
PRINT chr$(13);"[";STRING$(b/a*32,"-");">";STRING$((1.03-b/a)*32,"-");"| ";STR$(INT(b/a*100),3,3);"% ]";
FLUSH
RETURN
......@@ -7,8 +7,8 @@ dx=12/sx
dy=12/sy
m=120
gelb=get_color(65535,65535,0)
gruen=get_color(10000,65535,10000)
gelb=GET_COLOR(65535,65535,0)
gruen=GET_COLOR(10000,65535,10000)
PRINT "Netzgraf von Markus Hoffmann 1987 "
s=60/sx*4.5
......
......@@ -3,7 +3,7 @@
' (c) Markus Hoffmann 1990
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
mf%=maxworld%*13*8
world%=MALLOC(mf%)
......
......@@ -45,7 +45,7 @@ memory$=INPUT$(#1,LOF(#1))
CLOSE #1
pcl=VARPTR(memory$) !+28
memlen=len(memory$)
memlen=LEN(memory$)
MEMDUMP pcl,memlen
'
PRINT "; output of 68000dis.bas"
......@@ -320,14 +320,14 @@ FUNCTION ea$(wu)
ADD pcl,2
RETURN STR$(@dpeek(pcl-2) AND 0xFFF)+"(pc,"+CHR$(ASC("A")+ABS(NOT BTST(@dpeek(pcl-2),15))*(ASC("D")-ASC("A")))+".W)"
CASE 0x3c
IF tf$="Ea(AM_D)" or tf$="Ea(*)"
IF tf$="Ea(AM_D)" OR tf$="Ea(*)"
ADD pcl,4
ADD bll,4
return @value$(@lPEEK(pcl-4))
RETURN @value$(@lPEEK(pcl-4))
ELSE
ADD pcl,2
ADD bll,2
RETURN @value$(@DPEEK(pcl-2))
RETURN @value$(@DPEEK(pcl-2))
ENDIF
DEFAULT
RETURN "ERROR"
......@@ -357,7 +357,7 @@ FUNCTION bwl2$
CASE 3
RETURN "" !".W"
CASE 2
RETURN ".L"
RETURN ".L"
DEFAULT
RETURN "-BWL2-ERROR-"
ENDSELECT
......@@ -399,10 +399,10 @@ FUNCTION areg$(i%)
ENDFUNC
'
FUNCTION dpeek(adr%)
RETURN (peek(adr%) and 0xff)*256+(peek(adr%+1) and 0xff)
RETURN (PEEK(adr%) AND 0xff)*256+(PEEK(adr%+1) AND 0xff)
ENDFUNCTION
FUNCTION lpeek(adr%)
RETURN (peek(adr%) and 255)*256*256*256+(peek(adr%+1) and 255)*256*256+(peek(adr%+2) and 255)*256+(peek(adr%+3) and 255)
RETURN (PEEK(adr%) AND 255)*256*256*256+(PEEK(adr%+1) AND 255)*256*256+(PEEK(adr%+2) AND 255)*256+(PEEK(adr%+3) AND 255)
ENDFUNCTION
PROCEDURE add_symbol(adr%)
......@@ -426,11 +426,11 @@ FUNCTION value$(val%)
fl=0
s$=""
FOR i=0 TO 3
a=SHR(val% and SHL(0xff,(3-i)*8),(3-i)*8)
IF a>=asc(" ") AND a<127
s$=s$+chr$(a)
a=SHR(val% AND SHL(0xff,(3-i)*8),(3-i)*8)
IF a>=ASC(" ") AND a<127
s$=s$+CHR$(a)
ELSE
IF a<>0 OR len(s$)>0
IF a<>0 OR LEN(s$)>0
fl=1
ENDIF
ENDIF
......@@ -439,15 +439,15 @@ FUNCTION value$(val%)
RETURN "#'"+s$+"'"
ENDIF
IF val%>0 AND val%<32
RETURN "#"+str$(val%)
RETURN "#"+STR$(val%)
ENDIF
IF val%>0 AND val%<1024
RETURN "#"+str$(val%)
RETURN "#"+STR$(val%)
ENDIF
IF val%>0 AND val%<=0xffff
RETURN "#$"+hex$(val%,4)
RETURN "#$"+HEX$(val%,4)
ENDIF
RETURN "#$"+hex$(val%,8)
RETURN "#$"+HEX$(val%,8)
ENDFUNCTION
'
......
' 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 "
text$="This example demonstrates the use of the old Atari-ST fonts!"+CHR$(14)+CHR$(15)+" We used "
COLOR COLOR_RGB(0.1,0,0)
CLEARW 1
GET_GEOMETRY 1,bx%,by%,bw%,bh%
......
......@@ -2,12 +2,12 @@
scale=2
COLOR get_color(65535,65535,0)
SIZEW ,scale*16*16+32,scale*16*16
f1$=param$(2)
f2$=param$(3)
f1$=PARAM$(2)
f2$=PARAM$(3)
PRINT "font1: ";f1$
PRINT "font2: ";f2$
IF exist(f1$) AND exist(f2$)
IF exist(f1$) AND EXIST(f2$)
OPEN "I",#1,f1$
OPEN "I",#2,f2$
ff1$=input$(#1,4096)
......@@ -27,15 +27,15 @@ STOP
OPEN "O",#1,"out.fnt"
FOR i=0 TO 255
FOR j=0 TO 15
PRINT #1,chr$(peek(varptr(f$)+i+j*256));
PRINT #1,CHR$(PEEK(VARPTR(f$)+i+j*256));
NEXT j
NEXT i
CLOSE
QUIT
PROCEDURE text(t$)
LOCAL i
FOR i=0 TO len(t$)-1
char=peek(varptr(t$)+i)
FOR i=0 TO LEN(t$)-1
char=PEEK(VARPTR(t$)+i)
@char(x,y,char)
VSYNC
......@@ -50,7 +50,7 @@ PROCEDURE char1(x,y,c)
LOCAL i,j
FOR i=0 TO 15
FOR j=0 TO 7
IF btst(peek(varptr(ff1$)+i+c*16),7-j)=0
IF btst(PEEK(VARPTR(ff1$)+i+c*16),7-j)=0
PBOX x+j*scale,y+i*scale,x+j*scale+scale,y+i*scale+scale-1
ENDIF
NEXT j
......@@ -60,7 +60,7 @@ PROCEDURE char2(x,y,c)
LOCAL i,j
FOR i=0 TO 15
FOR j=0 TO 7
IF btst(peek(varptr(ff2$)+i+c*16),7-j)=0
IF btst(PEEK(VARPTR(ff2$)+i+c*16),7-j)=0
PBOX x+j*scale,y+i*scale,x+j*scale+scale,y+i*scale+scale-1
ENDIF
NEXT j
......
' Displays Atari-ST 8*16 fixed Fonts (c) Markus Hoffmann
scale=2
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)
FILESELECT "FONT-Laden","./*.fnt","",f$
......@@ -11,7 +11,7 @@ IF len(f$)
f$=input$(#1,4096)
CLOSE #1
FOR i=0 TO 256
text$=text$+chr$(i)
text$=text$+CHR$(i)
NEXT i
ENDIF
@text(text$)
......@@ -20,15 +20,15 @@ ENDIF
OPEN "O",#1,"out.fnt"
FOR i=0 TO 255
FOR j=0 TO 15
PRINT #1,chr$(peek(varptr(f$)+i+j*256));
PRINT #1,CHR$(PEEK(VARPTR(f$)+i+j*256));
NEXT j
NEXT i
CLOSE
QUIT
PROCEDURE text(t$)
LOCAL i
FOR i=0 TO len(t$)-1
char=peek(varptr(t$)+i)
FOR i=0 TO LEN(t$)-1
char=PEEK(VARPTR(t$)+i)
@char(x,y,char)
VSYNC
......@@ -43,7 +43,7 @@ PROCEDURE char(x,y,c)
LOCAL i,j
FOR i=0 TO 15
FOR j=0 TO 7
IF btst(peek(varptr(f$)+c+i*256),7-j)=0
IF btst(PEEK(VARPTR(f$)+c+i*256),7-j)=0
PBOX x+j*scale,y+i*scale,x+j*scale+scale,y+i*scale+scale-1
ENDIF
NEXT j
......
' Displays Atari-ST 8*16 fixed Fonts (c) Markus Hoffmann
scale=2
weiss=get_color(65535,65535,0)
weiss=GET_COLOR(65535,65535,0)
n=19
o=-1
......@@ -8,7 +8,7 @@ x=0
y=0
text$=""
PRINT n,o
f$=param$(2)
f$=PARAM$(2)
IF exist(f$)
OPEN "I",#1,f$
l=lof(#1)
......@@ -17,7 +17,7 @@ IF exist(f$)
f$=input$(#1,4096)
CLOSE #1
FOR i=0 TO 256
text$=text$+chr$(i)
text$=text$+CHR$(i)
NEXT i
ENDIF
@text(text$)
......@@ -29,8 +29,8 @@ CLOSE #1
QUIT
PROCEDURE text(t$)
LOCAL i
FOR i=0 TO len(t$)-1
char=peek(varptr(t$)+i) and 255
FOR i=0 TO LEN(t$)-1
char=PEEK(VARPTR(t$)+i) and 255
@char(x,y,char)
VSYNC
......@@ -48,7 +48,7 @@ PROCEDURE char(x,y,c)
LOCAL i,j
FOR i=0 TO 15
FOR j=0 TO 7
IF btst(peek(varptr(f$)+c+i*256),7-j)=0
IF btst(PEEK(VARPTR(f$)+c+i*256),7-j)=0
PBOX x+j*scale,y+i*scale,x+j*scale+scale,y+i*scale+scale-1
ENDIF
NEXT j
......
......@@ -11,7 +11,7 @@ IF len(f$)
f$=input$(#1,4096)
CLOSE #1
FOR i=0 TO 256
text$=text$+chr$(i)
text$=text$+CHR$(i)
NEXT i
ENDIF
@text(text$)
......@@ -20,8 +20,8 @@ PAUSE 10
QUIT
PROCEDURE text(t$)
LOCAL i
FOR i=0 TO len(t$)-1
char=peek(varptr(t$)+i) and 255
FOR i=0 TO LEN(t$)-1
char=PEEK(VARPTR(t$)+i) and 255
@char(x,y,char)
VSYNC
ADD x,8*scale
......@@ -41,6 +41,6 @@ PROCEDURE char(x,y,c)
' endif
' next j
' next i
t$=mid$(f$,c*16+1,16*2)
t$=MID$(f$,c*16+1,16*2)
PUT_BITMAP t$,x,y,8,16
RETURN
......@@ -180,7 +180,7 @@ duration=100 ! run time seconds
PRINT "Calibrating Whetstone Benchmark"
PRINT
PRINT "12345678 modules";chr$(13);
PRINT "12345678 modules";CHR$(13);
FLUSH
DO ! calculate loops per second
TimeUsed=0
......@@ -527,8 +527,8 @@ PROCEDURE Pout
PRINT "#";
FLUSH
ELSE
PRINT left$(heading$(section)+space$(18),18);": result=";
PRINT left$(str$(results(section))+space$(16),16);
PRINT left$(heading$(section)+SPACE$(18),18);": result=";
PRINT left$(STR$(results(section))+SPACE$(16),16);
IF atype=1
flops(section)=smflops
ops(section)=999999
......
......@@ -46,7 +46,7 @@ WHILE count%<1545
WEND
SUB y0%,y_step%
WEND
IF (count% MOD 300) = 0
IF (count% MOD 300)=0
PRINT accum%
ENDIF
INC count%
......
......@@ -31,7 +31,7 @@ WHILE count%<1545 ! 1065
ENDIF
ELSE
temp%=x_x%-y_y%+x0% ! temp% = x*x - y*y + x0%
IF ((x%<0 and y%>0) OR (x%>0 and y%<0))
IF ((x%<0 AND y%>0) OR (x%>0 AND y%<0))
y%=trunc(x%*y%/100)+y0%
ELSE
y%=trunc(x%*y%/100)+y0% ! y = 2*x*y + y0%
......@@ -47,7 +47,7 @@ WHILE count%<1545 ! 1065
' print
SUB y0%,y_step%
WEND
IF (count% mod 300)=0
IF (count% MOD 300)=0
PRINT accum%
ENDIF
INC count%
......
......@@ -94,7 +94,7 @@ FUNCTION purify$(g$)
g$=replace$(g$,"+"," ")
g$=replace$(g$,"%0A"," ")
g$=replace$(g$,"%0D"," ")
FOR i=0 to 255
FOR i=0 TO 255
g$=replace$(g$,"%"+upper$(hex$(i,2,2)),chr$(i))
NEXT i
RETURN g$
......
......@@ -42,7 +42,7 @@ FUNCTION purify$(g$)
g$=replace$(g$,"+"," ")
g$=replace$(g$,"%0A"," ")
g$=replace$(g$,"%0D"," ")
FOR i=0 to 255
FOR i=0 TO 255
g$=replace$(g$,"%"+upper$(hex$(i,2,2)),chr$(i))
NEXT i
RETURN g$
......
......@@ -31,7 +31,7 @@ FUNCTION purify$(g$)
g$=replace$(g$,"+"," ")
g$=replace$(g$,"%0A"," ")
g$=replace$(g$,"%0D"," ")
FOR i=0 to 255
FOR i=0 TO 255
g$=replace$(g$,"%"+upper$(hex$(i,2,2)),chr$(i))
NEXT i
RETURN g$
......
......@@ -111,7 +111,7 @@ FUNCTION purify$(g$)
g$=REPLACE$(g$,"+"," ")
g$=REPLACE$(g$,"%0A"," ")
g$=REPLACE$(g$,"%0D"," ")
FOR i=0 to 255
FOR i=0 TO 255
g$=REPLACE$(g$,"%"+UPPER$(HEX$(i,2,2)),CHR$(i))
NEXT i
RETURN g$
......
......@@ -112,15 +112,15 @@ WEND
' else if b$="wpEdittime"
' wpedittime$=value$
' endif
' ' print b$,value$
' ' print b$,value$
' endif
' ' print i,a$,b$
' wend
PRINT "</pre>"
SPLIT selectedname$,"_",0,selectednachname$,selectedvorname$
IF button$="Add" or left$(button$,6)="Delete"
FOR i=0 to anzpeople-1
IF button$="Add" OR left$(button$,6)="Delete"
FOR i=0 TO anzpeople-1
IF selectedname$=nachname$(i)+"_"+vorname$(i)
nameselected=i
ENDIF
......@@ -175,19 +175,19 @@ IF button$="Add" or left$(button$,6)="Delete"
IF acount<2
newcontent$=newcontent$+t$+chr$(10)
ELSE
IF bcount=0 and glob(t$,"*"+selectednachname$+"*")
IF bcount=0 AND glob(t$,"*"+selectednachname$+"*")
INC matching
newcontent$=newcontent$+t$+chr$(10)
ELSE if bcount=1 and glob(t$,"*"+selectedvorname$+"*")
ELSE if bcount=1 AND glob(t$,"*"+selectedvorname$+"*")
INC matching
newcontent$=newcontent$+t$+chr$(10)
ELSE if matching<2 or bcount<5
ELSE if matching<2 OR bcount<5
newcontent$=newcontent$+t$+chr$(10)
ELSE
IF bcount=5
newcontent$=newcontent$+"|"
awaycount=awaycount(nameselected)
FOR i=0 to awaycount-1
FOR i=0 TO awaycount-1
newcontent$=newcontent$+juldate$(awaystart(nameselected,i))
IF i<awaycount-1
newcontent$=newcontent$+"<br>"
......@@ -197,7 +197,7 @@ IF button$="Add" or left$(button$,6)="Delete"
ELSE if bcount=6
newcontent$=newcontent$+"|"
awaycount=awaycount(nameselected)
FOR i=0 to awaycount-1
FOR i=0 TO awaycount-1
newcontent$=newcontent$+juldate$(awayend(nameselected,i))
IF i<awaycount-1
newcontent$=newcontent$+"<br>"
......@@ -207,7 +207,7 @@ IF button$="Add" or left$(button$,6)="Delete"
ELSE if bcount=7
newcontent$=newcontent$+"|"
awaycount=awaycount(nameselected)
FOR i=0 to awaycount-1
FOR i=0 TO awaycount-1
newcontent$=newcontent$+awaylocation$(nameselected,i)
IF i<awaycount-1
newcontent$=newcontent$+"<br>"
......@@ -217,7 +217,7 @@ IF button$="Add" or left$(button$,6)="Delete"
ELSE if bcount=8
newcontent$=newcontent$+"|"
awaycount=awaycount(nameselected)
FOR i=0 to awaycount-1
FOR i=0 TO awaycount-1
newcontent$=newcontent$+@subword$(awayreason$(nameselected,i))
IF i<awaycount-1
newcontent$=newcontent$+"<br>"
......@@ -251,7 +251,7 @@ PRINT "a second time."
PRINT "</ol>"
nameselected=-1
PRINT "Name: <select name=v>"
FOR i=0 to anzpeople-1
FOR i=0 TO anzpeople-1
PRINT "<option value="+nachname$(i)+"_"+vorname$(i);
IF selectedname$=nachname$(i)+"_"+vorname$(i)
PRINT " selected";
......@@ -268,7 +268,7 @@ IF nameselected<>-1
IF awaycount(nameselected)>0
' print "Awaycount=";awaycount(nameselected)
PRINT "<table border=1 cellspacing=0>"
FOR i=0 to awaycount(nameselected)-1
FOR i=0 TO awaycount(nameselected)-1
PRINT "<td>";juldate$(awaystart(nameselected,i));"</td><td>";
PRINT juldate$(awayend(nameselected,i));"</td><td>";awaylocation$(nameselected,i);
PRINT "</td><td>";awayreason$(nameselected,i);"</td><td>"
......@@ -379,12 +379,12 @@ PROCEDURE processline(ln$)
WEND
awaycount(anzpeople)=awaycount
ELSE if c=7
FOR mmm=0 to awaycount(anzpeople)-1
FOR mmm=0 TO awaycount(anzpeople)-1
WORT_SEP a$,"<br>",0,b$,a$
awaylocation$(anzpeople,mmm)=b$
NEXT mmm
ELSE if c=8
FOR mmm=0 to awaycount(anzpeople)-1
FOR mmm=0 TO awaycount(anzpeople)-1
WORT_SEP a$,"<br>",0,b$,a$
awayreason$(anzpeople,mmm)=b$
NEXT mmm
......@@ -503,7 +503,7 @@ FUNCTION getpagecontent(p$)
WEND
ELSE
PRINT encoding$,len(encoding$)
FOR i=0 to 10
FOR i=0 TO 10
LINEINPUT #1,t$
PRINT "<pre>"+t$+"</pre>"
NEXT i
......@@ -520,7 +520,7 @@ FUNCTION purify$(g$)
g$=replace$(g$,"+"," ")
g$=replace$(g$,"%0A"," ")
g$=replace$(g$,"%0D"," ")
FOR i=0 to 255
FOR i=0 TO 255
g$=replace$(g$,"%"+upper$(hex$(i,2,2)),chr$(i))
NEXT i
RETURN g$
......@@ -528,7 +528,7 @@ ENDFUNCTION
FUNCTION subword$(aa$)
LOCAL i
IF anzwords
FOR i=0 to anzwords-1
FOR i=0 TO anzwords-1
aa$=replace$(aa$,word$(i),"[["+word$(i)+"]]")
NEXT i
ENDIF
......
......@@ -25,7 +25,7 @@ ARRAYFILL name$(),""
today=julian(date$)
FOR i=0 to ndays-1
FOR i=0 TO ndays-1
timestamp(i)=today-7+i
NEXT i
......@@ -61,15 +61,15 @@ PRINT "<table border=2 width=1000% cellspacing=0>"
' 1. Header-Zeile (Wochentag)
PRINT "<tr><td></td>"
FOR i=0 to ndays-1
FOR i=0 TO ndays-1
status1=@isfeiertag(timestamp(i))
vollmond1=@isvollmond(timestamp(i))
IF timestamp(i)=today
PRINT "<th bgcolor=00ffff>"
ELSE if (timestamp(i) mod 7)=5 or status1=2
ELSE if (timestamp(i) mod 7)=5 OR status1=2
PRINT "<th bgcolor=ffff00>"
ELSE if (timestamp(i) mod 7)=6 or status1=1
ELSE if (timestamp(i) mod 7)=6 OR status1=1
PRINT "<th bgcolor=ff0000>"
ELSE
PRINT "<th>"
......@@ -83,14 +83,14 @@ NEXT i
PRINT "</tr>"
' 2. Header-Zeile (Tag im Monat)
PRINT "<tr><td></td>"
FOR i=0 to ndays-1
FOR i=0 TO ndays-1
status1=@isfeiertag(timestamp(i))
vollmond1=@isvollmond(timestamp(i))
IF timestamp(i)=today
PRINT "<th bgcolor=00ffff>"
ELSE if (timestamp(i) mod 7)=5 or status1=2
ELSE if (timestamp(i) mod 7)=5 OR status1=2
PRINT "<th bgcolor=ffff00>"
ELSE if (timestamp(i) mod 7)=6 or status1=1
ELSE if (timestamp(i) mod 7)=6 OR status1=1
PRINT "<th bgcolor=ff0000>"
ELSE
PRINT "<th>"
......@@ -101,13 +101,13 @@ NEXT i
PRINT "</tr>"
PRINT "<tr><td></td>"
FOR i=0 to ndays-1
FOR i=0 TO ndays-1
status1=@isfeiertag(timestamp(i))
IF timestamp(i)=today
PRINT "<th bgcolor=00ffff>"
ELSE if (timestamp(i) mod 7)=5 or status1=2
ELSE if (timestamp(i) mod 7)=5 OR status1=2
PRINT "<th bgcolor=ffff00>"
ELSE if (timestamp(i) mod 7)=6 or status1=1
ELSE if (timestamp(i) mod 7)=6 OR status1=1
PRINT "<th bgcolor=ff0000>"
ELSE
PRINT "<th>"
......@@ -119,7 +119,7 @@ FOR i=0 to ndays-1
NEXT i
PRINT "</tr>"
FOR i=0 to anzpeople-1
FOR i=0 TO anzpeople-1
PRINT "<tr>"
IF odd(i)
PRINT "<th bgcolor=dddddd>";
......@@ -127,13 +127,13 @@ FOR i=0 to anzpeople-1
PRINT "<th>";
ENDIF
PRINT name$(i)+"</th>"
FOR j=0 to ndays-1
FOR j=0 TO ndays-1
status1=@isfeiertag(timestamp(j))
IF timestamp(j)=today
PRINT "<td bgcolor=00ffff>"
ELSE if (timestamp(j) mod 7)=5 or status1=2
ELSE if (timestamp(j) mod 7)=5 OR status1=2
PRINT "<td bgcolor=ffffaa>"
ELSE if (timestamp(j) mod 7)=6 or status1=1
ELSE if (timestamp(j) mod 7)=6 OR status1=1
PRINT "<td bgcolor=ffaaaa>"
ELSE if odd(i)
PRINT "<td bgcolor=dddddd>"
......@@ -212,7 +212,7 @@ PROCEDURE ostern(jahr)
q=jahr div 4
a=jahr mod 19
b=(204-11*a) mod 30
IF b=28 or b=28
IF b=28 OR b=28
DEC b
ENDIF
i=b
......@@ -287,9 +287,9 @@ FUNCTION mondtag(n,nph)
as=359.2242+29.105356*c+((1.178e-4)-(1.55e-7)*t)*t^2
am=306.0253+385.816918*c+0.010730*t^2
jd=2415020+28*n+7*nph+0.75933+1.53058868*c
IF nph=0 or nph=2
IF nph=0 OR nph=2
ADD jd,(0.1734-3.93e-4*t)*sin(rad(as))-0.4068*sin(rad(am))
ELSE if nph=1 or nph=3
ELSE if nph=1 OR nph=3
ADD jd,(0.1721-4e-4*t)*sin(rad(as))-0.6280*sin(rad(am))
ELSE
RETURN 0
......@@ -299,7 +299,7 @@ ENDFUNCTION
FUNCTION isfeiertag(jd)
LOCAL j
status1=0
FOR j=0 to anzfeiertage-1
FOR j=0 TO anzfeiertage-1
IF glob(juldate$(jd),feierp$(j))
feier1$=feiern$(j)
status1=feiers(j)
......@@ -336,9 +336,9 @@ PROCEDURE processline(ln$)
IF left$(ln$,2)="|-"
IF len(name$(anzpeople))
IF awaycount>0
FOR kk=0 to awaycount-1
FOR ii=0 to ndays-1
IF timestamp(ii)>=awaystart(kk) and timestamp(ii)<=awayend(kk)
FOR kk=0 TO awaycount-1
FOR ii=0 TO ndays-1
IF timestamp(ii)>=awaystart(kk) AND timestamp(ii)<=awayend(kk)
IF len(awaylocation$(kk))
table$(ii,anzpeople)=table$(ii,anzpeople)+awaylocation$(kk)+"<br>"+awayreason$(kk)
ELSE
......@@ -389,12 +389,12 @@ PROCEDURE processline(ln$)
INC awaycount
WEND
ELSE if c=5
FOR mmm=0 to awaycount-1
FOR mmm=0 TO awaycount-1
WORT_SEP a$,"<br>",0,b$,a$
awaylocation$(mmm)=b$
NEXT mmm
ELSE if c=6
FOR mmm=0 to awaycount-1
FOR mmm=0 TO awaycount-1
WORT_SEP a$,"<br>",0,b$,a$
awayreason$(mmm)=b$
NEXT mmm
......
......@@ -25,7 +25,7 @@ ARRAYFILL name$(),"Name"
today=julian(date$)
FOR i=0 to ndays-1
FOR i=0 TO ndays-1
timestamp(i)=today-7+i
NEXT i
......@@ -60,15 +60,15 @@ PRINT "<table border=2 width=1000% cellspacing=0>"
' 1. Header-Zeile (Wochentag)
PRINT "<tr><td></td>"
FOR i=0 to ndays-1
FOR i=0 TO ndays-1
status1=@isfeiertag(timestamp(i))
vollmond1=@isvollmond(timestamp(i))
IF timestamp(i)=today
PRINT "<th bgcolor=00ffff>"
ELSE if (timestamp(i) mod 7)=5 or status1=2
ELSE if (timestamp(i) mod 7)=5 OR status1=2
PRINT "<th bgcolor=ffff00>"
ELSE if (timestamp(i) mod 7)=6 or status1=1
ELSE if (timestamp(i) mod 7)=6 OR status1=1
PRINT "<th bgcolor=ff0000>"