;
; BlitzBasic Biorhythmus von M.Rauch
;
; konvertiert zu PC BB am 20.03.2005
;

Global scx=800
Global scy=600
Global cx,cy
Global fy=14

Graphics scx,scy,16,1

;------------------------
 ;Für Function NumDays
 Dim MO(12)
 ;Yes, the following could be in a Data file To shrink the dgroup memory usage.
 ;This is clearer And keeps the constants safer than in a Data file.
 MO(1) = 31
 MO(2) = 28
 MO(3) = 31
 MO(4) = 30
 MO(5) = 31
 MO(6) = 30
 MO(7) = 31
 MO(8) = 31
 MO(9) = 30
 MO(10) = 31
 MO(11) = 30
 MO(12) = 31
;------------------------

;DebugLog numdays(\"08 Jun 1970\") ;-2764 Wert vom Amiga BB2
;DebugLog numdays(\"01 Jan 1978\") ;0 Wert vom Amiga BB2
;DebugLog numdays(\"01 Jan 1979\") 
;DebugLog numdays(\"02 Jan 1977\") 
;WaitKey
;End

mFont=LoadFont(\"FixedSys\",9,0) 
SetFont mFont

;-------------------------------------------

Main()
End

;-------------------------------------------

Function Main()

 ClsColor 7*16,7*16,14*16
 Cls

 ;
 Local heute$
 Local fdate
 Local eintr
 Local anz
 Local anz0
 Local xan,yan
 Local name$
 Local datum$
 Local birth

 heute$=CurrentDate()
 ;heute$=\"30 Dec 1971\"      ;************************ Tag=Geburtstag dann sind die 3 Kurven alle in der Mitte am 0 Punkt
 fdate=NumDays(heute$)
 Restore Daten
 Read eintr
 For anz=1 To eintr
  anz0=anz0+1
  If anz0=5 Then anz0=1:MouseWait
  If anz0=1 Then
   Cls 
   WColour 9
   WLocate 8,fy*1:Text cx,cy,\"Datum \"+heute$
   WColour 4
   WLocate 8,fy*3:Text cx,cy,\"PHYSICAL  körperlich\"
   WColour 5
   WLocate 8,fy*4:Text cx,cy,\"EMOTIONAL gefühlsmässig\"
   WColour 6
   WLocate 8,fy*5:Text cx,cy,\"INTELLECT Verstand\"
  End If
  If anz0=1 Then xan=7    :yan=80+64
  If anz0=2 Then xan=7+320:yan=80+64
  If anz0=3 Then xan=7    :yan=56+128+64
  If anz0=4 Then xan=7+320:yan=56+128+64
  Read name$
  Read datum$
  birth=NumDays(datum$)
  Kurve xan,yan,name$,birth,fdate
 Next

 While Not KeyHit(1)
  Delay 20
 Wend

End Function

;-------------------------------------------

Function Kurve(xan,yan,name$,birth,fdate)

  Local f#,fa#,tot#
  Local x#,y#
  Local dcycle#
  Local i
  Local xen,xmi,yen,ymi
  fa=1.0
  xen=xan+38*8*fa
  xmi=(xen-xan)/2+xan
  yen=yan+66*fa
  ymi=(yen-yan)/2+yan
  WColour 9
  WLocate xan,yan-3*8:Text cx,cy,name$+\" \"+datum$
  ;
  WColour 7
  WBox xan,yan-1,xen,yen+1
  WColour 0
  WBox xan,yan  ,xen,yen  
  WColour 7
  For i=xmi To xen Step 8
   Line i,yan,i,yen
  Next
  WColour 7
  For i=xmi To xan Step -8
   Line i,yan,i,yen
  Next
  WColour 8
  Line xmi,yan,xmi,yen

  For i=1 To 3
    Select i
      Case 1:dcycle=23  ;physical
      Case 2:dcycle=28  ;emotional
      Case 3:dcycle=33  ;intellectual
    End Select
    WColour i+3
    For x=-19 To 18
      tot=(fdate-birth+x) Mod dcycle  ;days since birth
      For f=0 To 1 Step .1              ;tween bits for sin
        y=AmigaSin((tot+f)*2.0*Pi/dcycle)*(33.0*fa)
        Plot xmi+(x+f)*8.0*fa,ymi-y
      Next
    Next
  Next

End Function

;-------------------------------------------

Function AmigaSin#(w#)

 ;r#=Pi/180.0 Sin(w/r)
 Return Sin(w/(Pi/180.0))

End Function

;-------------------------------------------

Function WColour(c)

 Select c
 Case 0:AColor 7,7,14
 Case 1:AColor 0,0,0
 Case 2:AColor 15,15,15
 Case 3:AColor 10,10,10
 Case 4:AColor 0,0,15
 Case 5:AColor 15,0,0
 Case 6:AColor 0,15,0
 Case 7:AColor  0, 0, 0 ;Box
 Case 8:AColor 15,15, 0 ;Mitte
 Case 9:AColor 15,15,15 ;Schrift
 End Select

End Function

;-------------------------------------------

Function AColor(r,g,b)
 Color r*16,g*16,b*16
End Function

;-------------------------------------------

Function WBox(x1,y1,x2,y2)
 Rect x1,y1,(x2-x1)+1,(y2-y1)+1,True
End Function

;-------------------------------------------

Function WLocate(x,y)
 cx=x
 cy=y
End Function

;-------------------------------------------

Function NumDays(Datum$)

 ;http://utilitybase.com/ref/?keyword=NumDays&funcgroup=BlitzBasic&action=Search
 ;Syntax : NumDays </ref?keyword=NumDays&funcgroup=BlitzBasic&action=Search> date$ ;converts dd/mm/yyyy to days since 1/1/1978 Numdays converts a Date$ in the above format to the day count format, where numdays is the number of days since 1/1/1978. 

 ;DD MON YYYY 

 ;DebugLog Datum$

 DayOfMonth = Mid(Datum$, 1, 2)
 monat$=Mid(Datum$, 4, 3)
 month =MonatFromStr(monat$) 
 year = Mid(Datum$, 8, 4)

 ;DebugLog DayOfMonth
 ;DebugLog month 
 ;DebugLog year 

 yearfrom=1978
 yearto=year
 s=1
 If yearto<yearfrom Then
  yearfrom=year
  yearto=1978
  s=-1
 EndIf

 ;DebugLog yearfrom
 ;DebugLog yearto

 ;Day 0 is Jan 1, 1978
 NumDays = 0 ;calls January 1 the number 0
 For TestYr = yearfrom To yearto-1 ;start a loop at Jan 1, 1978 adding days
  ;find If any year fits the definition of a leap year
  ;(This is the second part of Y2K compliance)
  If (TestYr Mod 4 = 0 And TestYr Mod 100 <> 0) Or (TestYr Mod 400 = 0) Then
   ;This is a leap year; Add the number of days in a leap year.
   NumDays = NumDays + 366
  Else ;Add the number of days in a regular year
   NumDays = NumDays + 365
  End If
 Next ;keep adding Until all days up To the current year Jan 1 are totalled

 ;we don't want To add the current year in Or we would be 365 days ahead
 ;thats why the loop specifies yearto - 1
 ;YearDays = NumDays ;we know we have at least this many days.

 NumDays =NumDays *s ;if the year before 1978 change the Sign

 ;Now we need To know If the _current_ year is a leap year.
 ;(This is the third part of Y2K compliance)
 If (year Mod 4 = 0 And year Mod 100 <> 0) Or (year Mod 400 = 0) Then
  ;It is a leap year. February has an extra day
  MO(2) = 29
 Else
  MO(2) = 28 ;normal
 End If

 For TestMo = 1 To month - 1 ;now do the same adding For the months
  NumDays = NumDays + MO(TestMo)
 Next ;again, don't add the current month

 ;now we add the days
 NumDays = NumDays + DayOfMonth-1 ;Numdays is the total of year days + month days,
                                ;DayOfMonth is the day of the month And cannot be 0

 ;this is as far as the DATE$ functions go in many microsoft products -
 ;they don't go the extra Step To find the day of the week, as shown below

 ;use the Mod Function To get rid of all whole weeks And get a number
 ;from 0 To 6 representing a day of the week
 ;DayOfWeekNum = NumDays Mod 7

 Return NumDays 

End Function

;-------------------------------------------

Function MonatFromStr(Monat$)
 
 Select Monat$
 Case \"Jan\":Return 1
 Case \"Feb\":Return 2
 Case \"Mar\":Return 3
 Case \"Apr\":Return 4
 Case \"May\":Return 5
 Case \"Jun\":Return 6
 Case \"Jul\":Return 7
 Case \"Aug\":Return 8
 Case \"Sep\":Return 9
 Case \"Oct\":Return 10
 Case \"Nov\":Return 11
 Case \"Dec\":Return 12
 End Select

 RuntimeError \"MonatFromStr \"+Monat$+\" ?!\"

End Function

;-------------------------------------------
.Daten
 Data 4
;
 Data \"Name1\"
 Data \"08 Jun 1970\"
;
 Data \"Name2\"
 Data \"01 May 1948\"
;
 Data \"Name3\"
 Data \"30 Dec 1971\"
;
 Data \"Name4\"
 Data \"27 Jan 1946\"
;
 Data \"Name5\"
 Data \"18 Nov 1940\"
;
 Data \"Name6\"
 Data \"29 Jun 1964\"
;
 Data \"Name7\"
 Data \"28 May 1963\"
;
 Data \"Name8\"
 Data \"22 Sep 1987\"
;