Repost: Biorythmus (SubNet, Feb. 89)
Frank Kaefer
Newsgroups: sub.sources.os9
Subject: Biorythmus
Message-ID: <47500001@stasys>
Date: 12 Feb 89 09:12:00 GMT
Distribution: sub
Organization: Chaotic Evil
Lines: 288
Nf-ID: #N:stasys:47500001:000:8472
Nf-From: stasys.UUCP!fkk Feb 12 10:12:00 1989
Hiya Folks!
Hier mal zu Abwechslung eine BASIC-Source aus dem Starnberger Land.
Das Programm ist fuer BASIC 09 geschrieben, duerfte aber auch leicht
portierbar sein. Es ist zwar schon etwas aelter, aber dennoch
brauchbar. Die korrekte Berechnung habe ich ueberprueft.
Gruss, Frank.
#|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of shell archive."
# Contents: br.bas
# Wrapped by root@stasys on Sun Feb 12 10:11:39 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'br.bas' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'br.bas'\"
else
echo shar: Extracting \"'br.bas'\" \(6692 characters\)
sed "s/^X//" >'br.bas' <<'END_OF_FILE'
XPROCEDURE bre
XREM --------------------------------------------------------------------
XREM Biorhythmus (c) by F.K. 1987 V 2.2e
XREM --------------------------------------------------------------------
XON ERROR GOTO 5
XDIM Wochentag(7):STRING
XDIM Monatstage(12):INTEGER
XREM --------------------------------------------------------------------
XREM Daten aus den Datazeilen lesen
XREM --------------------------------------------------------------------
XFOR I=1 TO 7
XREAD Wochentag(I)
XNEXT I
XFOR I=1 TO 12
XREAD Monatstage(I)
XNEXT I
XREM --------------------------------------------------------------------
XREM Daten
XREM --------------------------------------------------------------------
XDATA "Sunday","Monday","Tuesday","Wednesday","Thursday"
XDATA "Friday","Saturday"
XDATA 31,28,31,30,31,30,31,31,30,31,30,31
XREM --------------------------------------------------------------------
XREM Start
XREM --------------------------------------------------------------------
X1 REM
XPRINT #2
XPRINT #2,"Biorhythm (c) 1987 by F.Kaefer V2.2e"
XREM --------------------------------------------------------------------
XREM Eingabe des heutigen Datums
XREM --------------------------------------------------------------------
X10 REM
XPRINT #2
XPRINT #2,"Date [<RETURN> for Systemdate] (DD.MM.YYYY) : ";
XREM alt:INPUT #0,T,M,J
XINPUT #0,Dtmp$
XIF LEN(Dtmp$) <> 10 THEN
XREM Systemdatum einsetzen
XDtmp$=MID$(Date$,7,2)+"."+MID$(Date$,4,2)+".19"+LEFT$(Date$,2)
XENDIF
XT=VAL(LEFT$(Dtmp$,2))
XM=VAL(MID$(Dtmp$,4,2))
XJ=VAL(RIGHT$(Dtmp$,4))
XTh=T
XMh=M
XJh=J
XREM --------------------------------------------------------------------
XREM Eingabe des Geburtstages
XREM --------------------------------------------------------------------
X11 REM
XPRINT #2,"Birthday (DD.MM.YYYY) : ";
XREM alt:INPUT #0,T,M,J
XINPUT #0,Dtmp$
XIF LEN(Dtmp$) <> 10 THEN
XPRINT #2,"Wrong input!"
XGOTO 11
XENDIF
XT=VAL(LEFT$(Dtmp$,2))
XM=VAL(MID$(Dtmp$,4,2))
XJ=VAL(RIGHT$(Dtmp$,4))
XTg=T
XMg=M
XJg=J
XGOSUB 2
XTa=Ta-INT(Ta/7)*7
XGtag=Ta+1
XREM --------------------------------------------------------------------
XREM Ueberpruefung der Eingaben
XREM --------------------------------------------------------------------
XIF Jg>Jh THEN
XPRINT #2,"Wrong input!"
XGOTO 1
XENDIF
XIF Jg=Jh THEN
XIF Mg>Mh THEN
XPRINT #2,"Wrong input!"
XGOTO 1
XENDIF
XIF Mg=Mh THEN
XIF Tg>Th THEN
XPRINT #2,"Wrong input!"
XGOTO 1
XENDIF
XENDIF
XENDIF
XREM --------------------------------------------------------------------
XREM Abfrage, ob Kurve oder Tageswerte ausgegeben werden sollen
XREM --------------------------------------------------------------------
X20 REM
XPRINT #2,"Values of today or Graph (v/g) ";
XINPUT #0,Ausgabeart$
XIF Ausgabeart$="g" THEN
XGOTO 4
XENDIF
XIF Ausgabeart$ <> "v" THEN
XGOTO 20
XENDIF
XREM --------------------------------------------------------------------
XREM Berechnung der vergangenen Tage
XREM --------------------------------------------------------------------
XJ=Jg
XM=Mg
XT=Tg
XGOSUB 2
XTag=Ta
XJ=Jh
XM=Mh
XT=Th
XGOSUB 2
XTah=Ta
XTage=Tah-Tag
XGOSUB 100
XPRINT #1
XPRINT #1,"The birthday "; Tg; Mg; Jg; " is a "; Wochentag(Gtag)
XPRINT #1,"Age in days: "; Tage
XREM --------------------------------------------------------------------
XREM Berechnung der drei Werte fuer das angegebene Datum
XREM --------------------------------------------------------------------
XPhys=INT(50*(1+SIN((Tage/23-INT(Tage/23))*360*PI/180)))
XEmot=INT(50*(1+SIN((Tage/28-INT(Tage/28))*360*PI/180)))
XGeist=INT(50*(1+SIN((Tage/33-INT(Tage/33))*360*PI/180)))
XREM --------------------------------------------------------------------
XREM Ausgabe der Werte
XREM --------------------------------------------------------------------
XPRINT #1,"Biorhythm "; Th; Mh; Jh
XPRINT #1,"Physical: "; Phys; "%"
XPRINT #1,"Emotional: "; Emot; "%"
XPRINT #1,"Mental: "; Geist; "%"
XPRINT #1
XEND
XREM --------------------------------------------------------------------
XREM Unterprogramm zur Berechnung der vergangenen Tage
XREM --------------------------------------------------------------------
X2 REM
XTa=0
XIF M<=2 THEN
XTa=(M-1)*31
XGOTO 3
XENDIF
XIF J/4=INT(J/4) THEN
XTa=1
XIF J/100=INT(J/100) THEN
XTa=0
XIF J/400=INT(J/400) THEN
XTa=1
XENDIF
XENDIF
XENDIF
XTa=Ta+INT((306*M-324)/10)
X3 REM
XTa=Ta+(J-1)*365+INT((J-1)/4)
XTa=Ta-INT((J-1)/100)+INT((J-1)/400)
XTa=Ta+T
XRETURN
XREM --------------------------------------------------------------------
XREM Ausgabe einer Kurve
XREM --------------------------------------------------------------------
X4 REM
XPRINT #2,"How many days : ";
XINPUT #0,Ktage
XKtage=Ktage-1
XDIM Line$(51):STRING
XREM --------------------------------------------------------------------
XREM Berechnung der vergangenen Tage
XREM --------------------------------------------------------------------
XJ=Jg
XM=Mg
XT=Tg
XGOSUB 2
XTag=Ta
XJ=Jh
XM=Mh
XT=Th
XGOSUB 2
XTah=Ta
XTage=Tah-Tag
XGOSUB 100
XPRINT #1
XPRINT #1,"The birthday "; Tg; Mg; Jg; " is a "; Wochentag(Gtag)
XPRINT #1,"Age in days: "; Tage
XPRINT #1
XPRINT #1,TAB(15); "P=Physical, E=Emotional, M=Mental"
XPRINT #1
XPRINT #1,TAB(15); "bad condition"; TAB(52); "good condition"
XREM --------------------------------------------------------------------
XREM Schleife fuer die Ausgabe der Kurve
XREM --------------------------------------------------------------------
XFOR Z=Tage TO Tage+Ktage
XPhys=INT(50*(1+SIN((Z/23-INT(Z/23))*360*PI/180)))
XEmot=INT(50*(1+SIN((Z/28-INT(Z/28))*360*PI/180)))
XGeist=INT(50*(1+SIN((Z/33-INT(Z/33))*360*PI/180)))
XREM --------------------------------------------------------------------
XREM Ausgabe der Werte als Kurve
XREM --------------------------------------------------------------------
XPRINT #1,Th; Mh; Jh;
XPRINT #1,TAB(15);
XPhys=INT(INT(Phys)/2+.5)
XEmot=INT(INT(Emot)/2+.5)
XGeist=INT(INT(Geist)/2+.5)
XP=Phys+1
XE=Emot+1
XG=Geist+1
XREM --------------------------------------------------------------------
XFOR Cl=1 TO 51
XLine$(Cl)="."
XNEXT Cl
XLine$(P)="P"
XLine$(E)="E"
XLine$(G)="M"
XLIne$(25)="|"
XFOR Pl=1 TO 51
XPRINT #1,Line$(Pl);
XNEXT Pl
XPRINT
XREM --------------------------------------------------------------------
XTh=Th+1
XIF Th>Monatstage(Mh) THEN
XMh=Mh+1
XTh=1
XENDIF
XIF Mh>12 THEN
XJh=Jh+1
XMh=1
XENDIF
XNEXT Z
XPRINT #1
XEND
XREM --------------------------------------------------------------------
XREM Kopf BIORHYTHMUS
XREM --------------------------------------------------------------------
X100 REM
XPRINT #2
XPRINT #1,TAB(32);"BIORHYTHM"
XPRINT #1,TAB(32);"========="
XPRINT #1
XPRINT #1,TAB(23);"(c) 1987,1988 by F.Kaefer"
XRETURN
XREM --------------------------------------------------------------------
XREM Error Routine
XREM --------------------------------------------------------------------
X5 REM
XPRINT #2
XEND
XREM --------------------------------------------------------------------
XREM End of Program
XREM --------------------------------------------------------------------
X
END_OF_FILE
if test 6692 -ne `wc -c <'br.bas'`; then
echo shar: \"'br.bas'\" unpacked with wrong size!
fi
# end of 'br.bas'
fi
echo shar: End of shell archive.
exit 0
#|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|~|
--
+--------------------------------+ You look at every face in a crowd
| Frank Kaefer | f...@stasys.UUCP | Some shine and some keep you guessin'
| (Compuserve: 72427,2101) | ( OU812 )
+--------------------------------+
--
| Frank Kaefer | f...@stasys.sta.sub.org | Starnberg, Germany |
| Compuserve: 72427,2101 | Internet: frank....@Sun.COM |
| unido!sunde!fkaefer | fka...@Germany.Sun.COM |