Biorhythms_bas

In English: BIORYTHMES_BAS, a SuperBASIC program by JC Touzin of La Sarre, Québec, that asks for a person's birth date and a month and year, then plots the physical, emotional, intellectual and intuition biorhythm curves for that month in four screen windows. It needs a graphics screen-dump routine to print the result, such as GPRINT_PRT from the Easel microdrive, loaded at line 100. A sample screen and the full listing are given.

Printed title: Biorythmes_bas. The article below is in French, as printed in QL_DOC n11 (August-September 1989).

---

Le programme BIORYTHME_BAS, écrit par notre ami JC Touzin, a besoin d’un programme de copie graphique d’écran. Le fichier GPRINT_PRT présent sur le µdrive contenant le programme EASEL (celui qui fait des graphiques) peut très bien faire l’affaire. Il s’agira d’ajuster la ligne 100 en conséquence, pour le charger en mémoire.

  1 REMark BIORYTHMES_BAS
  2 REMark écrit par JC Touzin, La Sarre (Québec)
  3 :
 99 REMark remplacer "ram1_hc_bin" par votre programme de
          copie d'écran, par "mdv1_GPRINT_PRT" de EASEL
          par exemple...
100 CLEAR: a=RESPR(1000): LBYTES ram1_hc_bin,a
110 MODE 4
120   OPEN#4,scr: OPEN#5,scr: OPEN#6,scr: OPEN#7,scr
130 REPeat bio
140 intro
150 saisie
160 jour_mois ac,mc
170 courbe
180 INPUT#0,,"Encore (o/n)? ";o_n$
190 IF o_n$=="n": EXIT bio
200 END REPeat bio
210 CLOSE#4: CLOSE#5: CLOSE#6: CLOSE#7:STOP
220 DEFine PROCedure saisie
230 REMark saisie des données
240 PRINT#0,"Programme de calcul du biorythme."
250 INPUT#0,"Copie sur imprimante (o/n)?  ";i$
260 INPUT#0,"Nom de la personne ";nom_b$
270 PRINT#0,"Date de naissance:"
280 INPUT#0,"Jour (1-31)? ";jn;"   Mois (1-12)? ";mn;
    "   Année (ex. 1987)? ";an
290 SELect  ON mn
300 = 1 TO 2:factn=janv_fev(jn,mn,an)
310 = 3 TO 12:factn=autres_mois(jn,mn,an)
320 END SELect
330 PRINT#0,"Mois et année du calcul:"
340 INPUT#0,"Mois (1-12)? ";mc;"   Année (ex. 1986)? ";ac: jc=1
350 SELect ON mc
360 = 1 TO 2: factc=janv_fev(jc,mc,ac)
370 = 3 TO 12 : factc=autres_mois(jc,mc,ac)
380 END SELect
390 REMark PRINT factn: PRINT factc
400 s=23: t=28: z=33: ii=38
410 END DEFine saisie
420 DEFine FuNction janv_fev (jour,mois,annee)
430 RETurn 365*annee+jour+31*(mois-1)+INT((annee-1)/4)-
    INT(.75*(INT(((annee-1)/100)+1)))
440 END DEFine janv_fev
450 DEFine FuNction autres_mois (jour,mois,annee)
460 RETurn 365*annee+jour+31*(mois-1)-INT(.4*mois+2.3)+
    INT(annee/4)-INT(.75*(INT(annee/100)+1))
470 END DEFine autres_mois
480 DEFine PROCedure jour_mois (annee,mois)
490 SELect ON mois
500 =2: jour=28
510 =4,6,9,11: jour=30
520 =1,3,5,7,8,10,12: jour=31
530 END SELect
540 IF jour=28 AND annee/4=INT (annee/4): jour=29: END IF
550 SELect ON jour
560 =28: si=139.79
570 =29: si=144.16
580 =30: si=148.58
590 =31: si=153
600 END SELect
610 END DEFine jour_mois
620 DEFine PROCedure quel_mois (mois)
630 SELect ON mois
640 =1: nom_mois$="Janvier"
650 =2: nom_mois$="Février"
660 =3: nom_mois$="Mars"
670 =4: nom_mois$="Avril"
680 =5: nom_mois$="Mai"
690 =6: nom_mois$="Juin"
700 =7: nom_mois$="Juillet"
710 =8: nom_mois$="Août"
720 =9: nom_mois$="Septembre"
730 =10: nom_mois$="Octobre"
740 =11: nom_mois$="Novembre"
750 =12: nom_mois$="Décembre"
760 END SELect
770 END DEFine quel_mois
780 DEFine PROCedure graph
790 FOR n= 4 TO 7:SCALE#n, 100,0,0
800 FOR n=4 TO 7: LINE#n,15,12 TO 15,98
810 FOR n=4 TO 7: LINE#n,15,55 TO 153,55
820 FOR n=4 TO 7: AT#n,0,0:PRINT#n,"+1": AT#n,4,0:
    PRINT#n," 0": AT#n,8,0:PRINT#n,"-1"
830 FOR n=4 TO 7
840 FOR j=5 TO jour STEP 5:AT#n,5,j+2: PRINT#n,j:
    AT#n,0,j+2: PRINT#n,"|": AT#n,8,j+2:PRINT#n,"|"
850 END FOR n
860 quel_mois (mc)
870 AT#4,9,0: PRINT#4,"----Physique.  ";nom_mois$;" ";ac:
    AT#5,9,0: PRINT#5,"----Emotion.  ";nom_mois$;" ";ac
880 AT#6,9,0: PRINT#6,"----Intellect.  ";nom_mois$;" ";ac:
    AT#7,9,0: PRINT#7,"----Intuition.  ";nom_mois$;" ";ac
890 CLS#0: PRINT#0,"Biorythme de ";nom_b$: quel_mois (mn):
    PRINT#0,"Date de naissance: ";jn;" ";nom_mois$;" ";an;
900 END DEFine
910 DEFine PROCedure courbe
920  graph
930 canal=4: REMark physique
940 y=factc-factn
950 FOR x=15 TO si
960 POINT#canal, x,55+43*SIN(RAD(360)*(y/s))
970 y=y+.225806
980 END FOR x
990 canal=5: REMark  émotion
1000 y=factc-factn
1010 FOR x=15 TO si
1020 POINT#canal, x,55+43*SIN(RAD(360)*(y/t))
1030 y=y+.225806
1040 END FOR x
1050 canal=6: REMark intellect
1060 y=factc-factn
1070 FOR x= 15 TO si
1080 POINT#canal, x,55+43*SIN(RAD(360)*(y/z))
1090 y=y+.225806
1100 END FOR x
1110 canal=7: REMark intuition
1120 y=factc-factn
1130 FOR x=15 TO si
1140 POINT#canal, x,55+43*SIN(RAD(360)*(y/ii))
1150 y=y+.225806
1160 END FOR x
1170 IF i$=="o" : imprimante
1180 END DEFine courbe
1190 DEFine PROCedure intro
1200  WINDOW 512,256,0,0:PAPER 0:CLS
1210     fenetre 4,238,102,16,0,0
1220     fenetre 5,238,102,258,0,0
1230   fenetre 6,238,102,16,106,0
1240   fenetre 7,238,102,258,106,0
1250 fenetre 0,480,22,16,210,0
1260 END DEFine intro
1270 DEFine PROCedure fenetre (canal,x,y,ox,oy,couleur)
1280 WINDOW#canal,x,y,ox,oy
1290 PAPER#canal,couleur
1300 CLS#canal
1310 INK#canal,7*(couleur<4)
1320 BORDER#canal,1,7
1330 END DEFine fenetre
1340 DEFine PROCedure imprimante
1350 OPEN#3,ser
1360 PRINT#3,CHR$(27);"0" :REMark 1/8 interligne
1370 CLOSE#3
1380 CALL a
1390 END DEFine imprimante