4000  "N" clear :dim L$(1)*25:dim O$(4)*19
4003  pause "GEBURTSDATUM ?":radian 
4006  gosub 4051:A=N:Q$=H$:W$=J$:R=Y
4007  rem Copyright by F. Lorenz, D-32423 Minden, www.abyte.de 
4009  pause "HEUTIGES DATUM ?":gosub 4051:N=N-A
4012  gosub 4036:gosub 4039:gosub 4042:gosub 4044
4015  print "INT: ";I;"%":print "EMO:";E;"%":print "VIT: ";V;"%":using "####.##":print "ERF: ";??=00 (C);"%"
4018  wait 0:print "<T>AB:<K>URVE:<N>EUEING.":call 5311:AU=peek 65374
4021  if AU=78 wait 0:print "1=CE126P 2=CE515P":call 5311:DR=peek 65374:wait :goto 4081
4024  if AU=14 wait 0:print "1=CE126P 2=CE515P":call 5311:DR=peek 65374:if DR=51 goto 4193
4025  if (AU=14) and (DR=50) wait 0:print "Drucker arbeitet !":call 1208:goto 4114
4027  if AU=0 then wait :goto 4000
4030  if AU=6 then call 7980:end 
4033  goto 4018
4036  I=((N/33)-int (N/33))*2*pi :I=int (.5+10000*sin I)/100:U=I:return 
4039  E=((N/28)-int (N/28))*2*pi :E=int (.5+10000*sin E)/100:U=E:return 
4042  V=((N/23)-int (N/23))*2*pi :V=int (.5+10000*sin V)/100:U=V:return 
4044  C=(I+E+V)/3:U=C:return 
4045  gosub 4036:gosub 4039:gosub 4042:gosub 4044:return 
4051  input "TAG:";D:input "MONAT:";M:input "JAHR:";Y:if Y<100 then let Y=Y+1900
4054  N=Y*365+int (Y/4)+int (Y/400)-int (Y/100)
4055  if int (Y/4)<>Y/4 and M=2 and D>28 print "Falsches Datum !":goto 4000
4057  if int (Y/4)=Y/4 and M<3 then let N=N-1
4060  L$(1)="231223345566":N=N-20+asc mid$ (L$(1),M,1)+30*(M-2)+D
4063  P=N-7*int (N/7)+1:L$(1)="SASOMODIMIDOFR"
4066  B$=mid$ (L$(1),2*P-1,2):X=D:gosub 4069:wait 150:print " ";B$;"  ";H$;".";J$;".";K$:wait :return 
4069  H$=str$ X:if X<10 then let H$="O"+H$
4072  J$=str$ M:if M<10 then let J$="O"+J$
4075  K$=right$ (str$ Y,2):rem Year 2000 bug fixed PUE
4078  return 
4081  wait 0:print "Drucker arbeitet !":call 1208:wait 
4082  restore :for X=1 to M:read Z:next X:if int (Y/4)=Y/4 and M=2 then let Z=Z+1
4083  if DR=50 call 7980:lprint chr$ 27;"a";chr$ 27;"?a":poke 65440,80,80:poke 65439,130
4084  lprint "  BIORHYTMUS TABELLE"
4087  lprint " AUSGABE ERFOLGT IN %":lprint "":lprint "INT=GEIST  : EMO=GEFUEHL"
4090  lprint "VIT=KOERPER: ERF=ERFOLG"
4093  lprint "":lprint "GEBURTSDATUM: ";Q$;".";W$;".";str$ R:lprint ""
4096  data 31,28,31,30,31,30,31,31,30,31,30,31
4098  wait 0:print "Drucker arbeitet !":call 1208:wait 
4099  for X=D to Z
4100  gosub 4036:gosub 4039:gosub 4042:gosub 4045:N=N+1
4101  gosub 4069:lprint H$;".";J$;".";K$
4102  using "####.#"
4104  if D=X lprint "INT.:  EMO.: VIT.: ERF.:":goto 4107
4105  if (X/5)=int (X/5) lprint "INT.:  EMO.: VIT.: ERF.:"
4107  IX=??=00 (I):EX=??=00 (E):VX=??=00 (V):CX=??=00 (C)
4108  lprint IX;EX;VX;CX
4109  using 
4110  next X
4111  lprint "":N=N-(Z-D+1):goto 4018
4114  call 7980:lprint chr$ 27;"a":lprint chr$ 27;"0":lprint chr$ 27;"?c":poke 65440,80,80:poke 65439,130
4117  lprint "               ";chr$ 27;"2";"************************";chr$ 27;"1"
4120  lprint "               *****";chr$ 27;"3";" BIORHYTMUS ";chr$ 27;"1";"*******"
4123  lprint "               ";chr$ 27;"2";"************************";chr$ 27;"0"
4126  lprint chr$ 27;"?b":lprint "                          GEBURTSDATUM:";Q$;".";W$;".";str$ R
4129  lprint "                          AUSGABEMONAT:  ";J$;".";K$:lprint chr$ 10
4132  restore :for X=1 to M:read Z:next X:if int (Y/4)=Y/4 and M=2 then let Z=Z+1
4135  poke 65439,132
4138  lprint "      GEIST=schwarz   ";chr$ 27;"1";"GEFUEHL=blau   ";chr$ 27;"2";"KOERPER=gruen"
4141  lprint chr$ 27;"3";"                                                     ERFOLG=rot"
4142  N=N-D
4144  lprint chr$ 27;"0";chr$ 10;chr$ 10;chr$ 10:lprint chr$ 27;"b"
4147  lprint "M500,0":lprint "I"
4150  lprint "M-5,15":lprint "P0":lprint "M";-485;",";15:lprint "P-100%":lprint "M";405;",";15:lprint "P+100%"
4153  lprint "H":lprint "L1":lprint "D0,-800":lprint "L3":lprint "M-450,0":lprint "J0,-800":lprint "M450,0":lprint "J0,-800"
4156  for JP=1 to Z:B$=str$ JP:lprint "M";-500;",";-JP*25-5:lprint "P";B$:lprint "M";-450;",";-JP*25
4158  if (JP/5)=int (JP/5) lprint "M";-440;",";-JP*25:lprint "D";-450;",";-JP*25
4159  lprint "D";-460;",";-JP*25:next JP:lprint "LO"
4162  for O=1 to Z:lprint "M";450;",";-O*25:lprint "D";460;",";-O*25
4165  if (O/5)=int (O/5) lprint "D";440;",";-O*25
4168  next O
4171  for Z1=1 to 4:B$=str$ (Z1-1):lprint chr$ 27;B$
4174  on Z1 gosub 4036,4039,4042,4045:U=U*4.5:lprint "M";U;",";0
4177  for X=1 to Z:N=N+1:on Z1 gosub 4036,4039,4042,4045:U=U*4.5
4180  lprint "L0":lprint "D";U;",";-X*25
4183  next X:N=N-Z
4189  next Z1
4192  N=N+D:poke 65439,130:lprint "A":goto 4018
4193  rem UNTERPROGRAMM FUER CE126P 
4302  wait 0:print "Drucker arbeitet !":call 1208:wait 
4303  lprint "":lprint "***********************":lprint "***** BIORHYTHMUS *****"
4305  lprint "***********************":lprint ""
4308  lprint "GEBURTSDATUM: ";Q$;".";W$;".";str$ R:lprint ""
4311  restore :for X=1 to M:read Z:next X:if int (Y/4)=Y/4 and M=2 then let Z=Z+1
4314  O$(1)="    G E I S T":O$(2)="   G E F U E H L":Z1=1:N=N-D
4317  O$(3)="   K O E R P E R":O$(4)="   E R F O L G"
4320  lprint "AUSGABEMONAT:  ";J$;".";K$:lprint ""
4323  for Z1=1 to 4
4326  lprint O$(Z1):lprint "":lprint "           O":lprint "  IIIIIIIIIIIIIIIIIIIII"
4329  for X=1 to Z:N=N+1:on Z1 gosub 4036,4039,4042,4045:U=int (U/10+11.5)
4332  L$(1)="-":if X/10=int (X/10) then let L$(1)="--"
4335  if U=1 then 4341
4338  for X1=1 to U-1:L$(1)=L$(1)+" ":next X1
4341  L$(1)=L$(1)+"*"
4344  lprint L$(1):next X:N=N-Z
4347  lprint ""
4350  next Z1:N=N+D:goto 4018