Print Page - Coding Conversion Problem

Active Forums => QB64 Discussion => Topic started by: GeorgeLee on June 01, 2020, 05:18:58 pm

Title: Coding Conversion Problem
Post by: GeorgeLee on June 01, 2020, 05:18:58 pm

I wrote a software program in BASIC PDS about 35 years ago and want to utilize it for my 64 Bit
computers in my home using QB64. I am now 74 years old and have trouble remembering so I cannot attempt
to learn another language therefore, would appreciate help with this problem. Virtual Windows XP
is NOT an option with my Windows 10 computers. I know that the rest of the software program
works with Windows 10, but the info from the DEF FNname routine makes the use of the software
unusable.

Can anyone help me change the following DEF FNname lines to a FUNCTION in QB64 BASIC formula?

   DEF FNA (Z) = CDBL(INT((SIN((V / Z - INT(V / Z)) * P#) + 1) * 13.5))
   DEF FNG (Z) = 100 * SIN(V / Z * P#)
   DEF FNB = V - 28 * INT(V / 28) + 1
   DEF FNC = V - 23 * INT(V / 23) + 1
   DEF FND = V - 33 * INT(V / 33) + 1

Thanks in advance,
George Lee

Title: Re: Coding Conversion Problem
Post by: Cobalt on June 01, 2020, 06:51:27 pm

B,C,D should all be good. Not 100% sure on A and G, but see if these give you what you need.

Code: QB64: [Select]

' DEF FNA (Z) = CDBL(INT((SIN((V / Z - INT(V / Z)) * P#) + 1) * 13.5))
' DEF FNG (Z) = 100 * SIN(V / Z * P#)
' DEF FNB = V - 28 * INT(V / 28) + 1
' DEF FNC = V - 23 * INT(V / 23) + 1
' DEF FND = V - 33 * INT(V / 33) + 1
'
FUNCTION A# (V, Z, P#)
 Result# = CDBL(INT((SIN((V / Z - INT(V / Z)) * P#) + 1) * 13.5))
 A = Result#
END FUNCTION
 
FUNCTION G# (V, Z, P#)
 Result# = 100 * SIN(V / Z * P#)
 G = Result#
END FUNCTION
 
FUNCTION B (V)
 Result = V - 28 * INT(V / 28) + 1
 B = Result
END FUNCTION
 
FUNCTION C (V)
 Result = V - 23 * INT(V / 23) + 1
 C = Result
END FUNCTION
 
FUNCTION D (V)
 Result = V - 33 * INT(V / 33) + 1
 D = Result
END FUNCTION
 

Title: Re: Coding Conversion Problem
Post by: Cobalt on June 01, 2020, 06:53:45 pm

Oh Yeah, my manners....

Welcome to the Forums!

Title: Re: Coding Conversion Problem
Post by: GeorgeLee on June 03, 2020, 04:29:03 pm

Thank you for your probable solution AND for your WELCOME. I have been trying to implement the solution for the past three days straight to no avail. If you could/would look at the original source code (I will attempt to paste it here), maybe you could help me solve the problem. I would be happy to compensate you for your assistance (just let me know how much). Thank YOU, George Lee

'----------------------FUNCTION 1 DEFINITION BEGIN LINE 460
'----------------------FUNCTION 2 DEFINITION BEGIN LINE 1770
'
1 ' BioGraph.Bas, (C) 1985-2020, GEORGE A LEE, BioRhythm, (575) 623-8365
CDate$ = "1985-2020"
version$ = "Version. 4.0"
Hit = 0
KEY OFF
ON ERROR GOTO FIXIT
ELine = 50
2 WIDTH 80, ELine
GOTO 6
FIXIT:
IF ELine = 50 THEN ELine = 43: RESUME 2
IF ELine = 43 THEN ELine = 25: RESUME 3
RESUME NEXT
3 ELine = 25
6 WIDTH 80, 25
14 KEY OFF
15 LGreen = 10: LGRAY = 7: Cyan = 11: LRed = 12: Magenta = 13: Yellow = 14
20 DIM CR$(26), Start(26), FINISH(26)
30 C = 9
40 FOR I = 1 TO 26
50 CR$(I) = CHR$(64 + I)
60 Start(I) = C + 1
70 FINISH(I) = C + 100
80 C = C + 100
90 NEXT I
100 ON ERROR GOTO 3900
110 CLS
120 LOCATE 6, 1, 0
140 CP$ = "###.##%"
X$ = version$
Hit = 0
200 FOR Delay = 1 TO 3000: NEXT Delay: CLS : WIDTH 80
220 DIM A(12), D(12)
230 CLS
235 'WIDTH 80, 25: VIEW PRINT 1 TO ELine: LOCATE , , 0
'IF pcpy AND ELine = 25 THEN PCOPY 1, 0: GOTO 370
236 'BLOAD PATH$ + "biograph.ov1": PCOPY 0, 1: pcpy = 1
237 GOTO 370
240 PRINT "BIO-RHYTHMS"; TAB(51); "(c) "; CDate$; " by George A. Lee"
250 FOR B = .2 TO 3 STEP .2
270 y = SIN(B)
280 PRINT TAB(20 * y + 9); CHR$(1);
290 PRINT TAB(40 * y + 10); CHR$(3);
300 PRINT TAB(50 * y + 10); CHR$(215);
310 ' formula from 'COMPUTER GAMES',J.V.NAHIGIAN,W.S.HODGES
320 ' formula translated to Model 4 by GEORGE A. LEE, 12/85
330 NEXT B
340 PRINT
350 PRINT "This program can chart your daily BIO-RHYTHMIC patterns, or determine compat-"
360 PRINT "ability of two individuals.": PRINT STRING$(80, "-");
370 FOR I = 1 TO 12
380 READ A(I)
390 NEXT I
400 FOR I = 1 TO 12
410 READ D(I)
420 NEXT I
430 DATA 0,31,59,90,120,151,181,212,243,273,304,334
440 DATA 31,28,31,30,31,30,31,31,30,31,30,31

'----------------------FUNCTION 1 DEFINITION BEGIN--------------------------------
460 DEF FNA (Z) = CDBL(INT((SIN((V / Z - INT(V / Z)) * P#) + 1) * 13.5))
470 DEF FNG (Z) = 100 * SIN(V / Z * P#)
480 DEF FNB = V - 28 * INT(V / 28) + 1
490 DEF FNC = V - 23 * INT(V / 23) + 1
500 DEF FND = V - 33 * INT(V / 33) + 1
'----------------------FUNCTION 1 DEFINITION END--------------------------------

505 WF$ = ""
506 'GOTO 550
510 LOCATE 19, 1
515 PRINT "<1> Single person chart"
520 PRINT "<2> Two person compatability"
530 PRINT "<3> End program"
540 PRINT "<4> EDIT file"
550 ED$ = "4"
LOCATE 23, 1: COLOR Yellow: PRINT "<"; : COLOR Magenta: PRINT "5"; : COLOR Yellow: PRINT ">"; : COLOR Cyan: PRINT " OOPs, Wanted Printer Verson"
KY$ = INPUT$(1): IF INSTR("1235" + ED$, KY$) = 0 THEN 550
560 KY = VAL(KY$): LOCATE , , 1
570 ON KY GOTO 580, 2370, 3300, 3840, 3861
575 NFME$ = TempName$: TempName$ = ""
580 FOR I = 0 TO 4: LOCATE 19 + I, 1: PRINT SPACE$(60); : NEXT I: LOCATE 19, 1: I = 0
585 IF LEFT$(NFME$, 1) = "m" OR LEFT$(NFME$, 1) = CHR$(0) THEN NFME$ = Ne$
590 COLOR Yellow, 0: PRINT "Name on chart: "; NFME$ + STRING$(10, 32); : COLOR 7: LOCATE 19, 16: LINE INPUT Ne$: IF Ne$ = "" THEN Ne$ = NFME$
600 GOSUB 3760: LOCATE 19, 16: PRINT STRING$(27, 32), ; : LOCATE 19, 16: PRINT Ne$;
610 NFME$ = Ne$: Name1$ = Ne$
620 'IF WF$="N" THEN 660
630 GOSUB 3460
640 NFME$ = N1$
650 YB = VAL(MID$(DT1$, 7))
660 COLOR Cyan, 1: CLS : LOCATE 1, 1: PRINT "This chart specifically printed for "; Ne$; "."
670 PRINT "Compiled on "; DATE$; " - "; "(c) "; CDate$; " by George A. Lee"
680 COLOR LRed: PRINT TAB(12); "Biorhythm is the rhythmic course of the life process of an individual."
690 PRINT : COLOR Yellow: PRINT "The MEDIAN, line (0), is the critical and is when most accidents MAY occur.": PRINT TAB(12); "The high periods (+) are when you have the most energy, and the low"
700 PRINT TAB(12); "periods (-) are regarded as recuperative periods.": COLOR Cyan
710 LOCATE 21, 1: PRINT STRING$(80, 32); : LOCATE 22, 1: PRINT STRING$(80, 32);
715 LOCATE 21, 1: COLOR LGreen
PRINT "STARTING DATE FOR CHART? (Default=";
COLOR 15: PRINT DATE$; : COLOR LGreen: PRINT ") ";
Sharon1 = POS(Sharon1) + 1: LOCATE , Sharon1: PRINT " - -"; : COLOR Cyan
720 LOCATE , Sharon1: UUU = Sharon1: UU = 20: U = 1: GOSUB 3320: m = VAL(ab$): IF m <= 0 THEN m = VAL(DATE$): DD = VAL(MID$(DATE$, 4, 2)): y = VAL(RIGHT$(DATE$, 4)): LOCATE CSRLIN, Sharon1: PRINT DATE$: GOTO 760
730 IF (m <= 0) + (m > 12) THEN BEEP: GOTO 720
Sharon2 = Sharon1 + 3
740 LOCATE , Sharon2: U = 1: UUU = Sharon2: GOSUB 3320: DD = VAL(ab$): IF (DD <= 0) + (DD > 31) THEN BEEP: GOTO 740
750 LOCATE , Sharon2 + 3: U = 3: UUU = Sharon2 + 3: GOSUB 3320: IF ab$ = "" THEN BEEP: GOTO 750
y = VAL(ab$)
760 ab$ = ""
780 IF YS > YB THEN 1130
800 DTP = ELine: '15.5
810 M2 = m
820 D2 = DD
830 Y3 = y
840 Y5 = y
850 GOSUB 2170
860 Z = T
870 PRINT
880 IF DT1 > 0 THEN m = DT1: DD = DT2: y = DT3: DT1 = 0: GOTO 1020
886 GOSUB 3910
887 IF WF$ = "N" THEN 910
EGEN$ = "ENTER " + UCASE$(Ne$) + "'S GENDER: "
890 LOCATE 23, 1: PRINT EGEN$ + STRING$(60 - LEN(Ne$), 32); : LOCATE 23, LEN(EGEN$) + 2: LINE INPUT Gender$: LOCATE 23, 1: PRINT STRING$(60, 32);
900 GOSUB 3870
910 IF WF$ = "N" THEN NFME$ = Ne$
915 LOCATE 23, 1: PRINT SPC(70);
916 LOCATE 23, 1: PRINT "ENTER "; UCASE$(Ne$); "'S BIRTHDATE ("; : COLOR 15: PRINT "MM-DD-YYYY"; : COLOR Cyan: PRINT ") ";
Sharon1 = POS(Sharon1) + 1: LOCATE , Sharon1: PRINT " - -";
920 LOCATE , Sharon1: UUU = Sharon1: U = 1: UU = CSRLIN - 1: GOSUB 3320: m = VAL(ab$): IF (m <= 0) + (m > 12) THEN BEEP: GOTO 920
930 AD3$ = ab$ + "-": EY$ = ab$: ab$ = "": Sharon2 = Sharon1 + 3
940 LOCATE , Sharon2: U = 1: UUU = Sharon2: GOSUB 3320: DD = VAL(ab$): IF (DD <= 0) + (DD > 31) THEN BEEP: GOTO 940
950 AD4$ = ab$ + "-": EY$ = EY$ + ab$: ab$ = ""
960 LOCATE , Sharon2 + 3: U = 3: UUU = Sharon2 + 3: GOSUB 3320: IF ab$ = "" THEN BEEP: GOTO 960
970 y = VAL(ab$)
UUU = 0
ab$ = RIGHT$(STR$(y), 4)
980 AD2$ = AD3$ + AD4$ + ab$
990 AD1$ = Ne$
1000 IF WF$ = "N" THEN 1020
1010 GOSUB 3640
1020 PRINT "Any changes (Y/N) ? ";
1030 YN$ = INPUT$(1): IF (YN$ = "Y") + (YN$ = "y") THEN TempName$ = Ne$: GOTO 575 ELSE IF (YN$ = "N") + (YN$ = "n") THEN 1050
1040 GOTO 1030
1050 COLOR 7, 0: ab$ = ""
1060 M1 = m
1070 D1 = DD
1080 Y2 = y
1085 GOTO 1140
1100 IF AD1$ <> "" THEN 1140
1130 LOCATE 23, 1: PRINT "******* Don't try to kid me, You weren't born yet!!!! Try again.": PRINT SPACE$(50); : FOR Delay = 1 TO 1000: NEXT Delay: GOTO 580
1140 GOSUB 2170
1145 IF T > Z THEN 1130
1150 V = T - Z
1160 V = ABS(V)
1180 IF ELine > 25 THEN WIDTH 80, ELine
VIEW PRINT 1 TO ELine: COLOR Cyan, 1: CLS
1190 PRINT "GRAPH SYMBOLS: "; : COLOR 12: PRINT CHR$(3); : COLOR 15: PRINT " Physical Cycle (23 day)";
COLOR Yellow: PRINT TAB(51); "(c)"; CDate$; " by George A. Lee"
1200 COLOR 10: PRINT TAB(17); CHR$(1); : COLOR 15: PRINT " Sensitivity (emotional) Cycle (28 day)"
1210 COLOR 11: PRINT TAB(17); CHR$(251); : COLOR 15: PRINT " Cognitive (intellectual) Cycle (33 day)"
1220 COLOR 12: PRINT TAB(17); "**"; : COLOR 15: PRINT " Critical day. Most accidents MAY occur."
1230 IF INSTR(Ne$, " ") <= 0 THEN IST = LEN(Ne$) ELSE IST = INSTR(Ne$, " ") - 1
1240 COLOR LGreen: PRINT LEFT$(Ne$, IST); ", "; "you were born on ";
1250 B9 = J + 1
1260 GOSUB 2110
1270 PRINT AY$; ", ";
1280 A9 = M1
1290 GOSUB 2080
1300 PRINT MT$;
1310 PRINT STR$(D1) + ","; Y2; "-";
1320 PRINT USING " ######, days OR ###.# years ago."; V; V / 365.25#: PRINT
1340 m$ = "DATE (-) (0) (+) CAPABILITY %-TILE"
1350 y = 5
1360 X = 0
1370 COLOR 10, 1: LOCATE 6, 1: LOCATE 6, 59: PRINT CHR$(1); : COLOR 11: PRINT " " + CHR$(251); : COLOR 12: PRINT " " + CHR$(3) + " **"; : COLOR 15
1380 LOCATE 7, 7: PRINT m$: COLOR 7
1390 J1 = V + J
1400 J1 = J1 - 7 * INT(J1 / 7)
1410 D2 = D2 - 1
1420 J1 = J1 - 1
1430 V = V - 1
1450 FOR I = 1 TO DTP - 9
1455 K = 0
1460 V = V + 1
1470 D2 = D2 + 1
1480 J1 = J1 + 1
1490 IF M2 <> 2 THEN 1520
1500 IF INT(Y3 / 4) <> Y3 / 4 THEN 1520
1510 K = 1
1520 IF D2 <= D(M2) + K THEN 1550
1530 M2 = M2 + 1
1540 D2 = 1
1550 IF J1 < 7 THEN 1570
1560 J1 = 0
1570 IF M2 <= 12 THEN 1620
1580 Happy$ = "* HAPPY NEW YEAR *"
1590 Happy = 1
1600 M2 = 1
1610 Y3 = Y3 + 1
1620 IF M2 <> M1 THEN 1670
1630 IF D2 <> D1 THEN 1670
1640 Happy$ = "*HAPPY" + STR$(Y3 - Y2) + " BIRTHDAY*"
1650 Happy = 1
1660 'PUT 'HAPPY BIRTHDAY' SONG IN HERE
1670 IF M2 <> 12 THEN 1710
1680 IF D2 <> 25 THEN 1710
1690 Happy$ = "* MERRY CHRISTMAS *"
1700 Happy = 1
1710 m$ = STR$(M2) + "-" + STR$(D2)
1720 IF VAL(RIGHT$(STR$(Y3), 4)) < 10 THEN YR1$ = "000" + RIGHT$(STR$(Y3), 1) ELSE YR1$ = RIGHT$(STR$(Y3), 4)
1730 COLOR 14: LOCATE 7 + I, 1: PRINT USING " ##_-##_-\ \"; M2; D2; YR1$: COLOR 7
1750 G = 20
1760 P# = 6.28318530717961#

'----------------------FUNCTION2 DEFINITION BEGIN--------------------------------
1770 C5 = FNA(33) + G
1780 S5 = FNA(28) + G
1790 P5 = FNA(23) + G
1800 LOCATE 7 + I, 34: PRINT CHR$(179);
1810 CH1$ = CHR$(2): CH2$ = CHR$(1)
1820 IF S5 > 33 THEN SWAP CH1$, CH2$
1830 LOCATE 7 + I, S5 + 1: COLOR 10: PRINT CH2$;
1840 LOCATE 7 + I, 57: PRINT USING "####"; FNG(28); : COLOR 7

1850 LOCATE 7 + I, C5 + 1: COLOR 11: PRINT CHR$(251);
1860 LOCATE 7 + I, 64: PRINT USING "####"; FNG(33); : COLOR 7

1870 LOCATE 7 + I, P5 + 1: COLOR 12: PRINT CHR$(3);
1880 LOCATE 7 + I, 71: PRINT USING "####"; FNG(23); : COLOR 7

1890 IF (S5 = 33) + (P5 = 33) + (C5 = 33) THEN LOCATE 7 + I, 79: COLOR 12 + 16: PRINT "**"; : COLOR 7

1900 IF FNG(28) = FNG(33) THEN LOCATE 7 + I, S5 + 1: PRINT " ";
1910 IF FNG(28) = FNG(23) THEN LOCATE 7 + I, S5 + 1: PRINT " ";
1920 IF FNG(23) = FNG(33) THEN LOCATE 7 + I, P5 + 1: PRINT " ";
'----------------------FUNCTION2 DEFINITION END--------------------------------

1930 IF Happy THEN GOSUB 2130
1940 IF M2 <> 1 THEN 1980
1950 IF D2 <> 1 THEN 1980
1960 m$ = "* HAPPY NEW YEAR *"
1970 GOSUB 2140
1980 NEXT I
1990 m$ = "Another chart? (Y/n) "
2000 LOCATE ELine - LastLine, 1: PRINT STRING$(70, 32);
2010 LOCATE ELine - LastLine, 1: COLOR 15: PRINT m$;
LastLine = 0
COLOR 7, 0
2020 KY$ = INKEY$
2030 IF KY$ = "" THEN 2020
2040 IF UCASE$(KY$) = "N" THEN CLS : GOTO 3300
2050 IF UCASE$(KY$) = "Y" THEN CLOSE : CLS : RUN
GOTO 2020
2060 CLS : CLOSE : LOCATE , , 0: SYSTEM 'RUN "BIORHYTH.EXE"
2080 MONTH$ = "JanFebMarAprMayJunJulAugSepOctNovDec"
2090 MT$ = MID$(MONTH$, A9 * 3 - 2, 3)
2100 RETURN
2110 DDAY$ = "WedThuFriSatSunMonTue"
2120 AY$ = MID$(DDAY$, B9 * 3 - 2, 3): RETURN
2130 IF Happy THEN SWAP m$, Happy$
2140 LOCATE 7 + I, 1:
IF Happy THEN COLOR LGreen + 16
PRINT m$;
COLOR 7
2150 Happy = 0
2160 RETURN
2170 y1 = y - 1800
2180 Q1 = INT(y1 / 4)
2190 Q2 = INT(Q1 / 25)
2200 Q3 = INT((y1 + 200) / 400)
2210 K = 0
2220 IF Q1 * 4 <> y1 THEN 2260
2230 IF Q2 * 100 <> y1 THEN 2260
2240 IF Q3 * 400 - 200 <> y1 THEN 2260
2250 K = 1
2260 T = 365 * y1 + Q1 - Q2 + Q3 - K
2270 T = T + A(m) + DD - 1
2280 IF m < 3 THEN 2300
2290 T = T + K
2300 IF INT(y1 / 4) <> y1 / 4 THEN 2330
2310 IF m > 2 THEN 2330
2320 T = T - 1
2330 J = T - 7 * INT(T / 7)
2340 RETURN
2350 END
2370 COLOR Cyan, 1: CLS
2380 PRINT " C O M P A T A B I L I T Y A N A L Y S I S"
2390 PRINT
COLOR Yellow
2400 PRINT " Two individuals will have an average compatability of 100%"
2410 PRINT " ONLY if they were born on the same day, or if they were born"
2420 PRINT " 21,252 days (58.1848 Years) apart. ";
2430 PRINT "Please do not be upset if": PRINT " your compatability average is less than 100%!"
2440 PRINT : IF NFME$ = "" THEN NFME$ = Name1$
COLOR Cyan
2460 LOCATE 10, 16: PRINT "What is person one's name? "; NFME$ + STRING$(8, 32); : LOCATE CSRLIN, 44: LINE INPUT A1$: IF A1$ = "" THEN A1$ = NFME$
2470 Ne$ = A1$: Name1$ = Ne$
2480 GOSUB 3760
2490 A1$ = Ne$
2500 NFME$ = A1$
2510 'IF INSTR(A1$," ")>0 THEN 2550
2520 GOSUB 3460
2530 IF DT1 > 0 THEN SWAP A1$, N2$
2540 IF DT1 > 0 THEN m = DT1: DD = DT2: y = DT3: DT1 = 0: GOTO 2620
2542 GOSUB 3910
2543 IF WF$ = "N" THEN 2560
2550 LOCATE 11, 16: PRINT "ENTER GENDER: "; : LINE INPUT Gender$: GOSUB 3870
2560 LOCATE 11, 16: PRINT "What is "; A1$; "'s ";
INPUT "birthday (MM,DD,YYYY)"; m, DD, y: IF LEN(LTRIM$(STR$(y))) < 4 THEN 2560
2570 IF m < 10 THEN AD3$ = "0" + RIGHT$(STR$(m), 1) ELSE AD3$ = RIGHT$(STR$(m), 2)
2580 IF DD < 10 THEN AD4$ = "0" + RIGHT$(STR$(DD), 1) ELSE AD4$ = RIGHT$(STR$(DD), 2)
2590 AD1$ = A1$: AD2$ = AD3$ + "-" + AD4$ + "-" + RIGHT$(STR$(y), 4)
2600 IF WF$ = "N" THEN 2620
2610 GOSUB 3640
2620 E1 = m
2630 F1 = DD
2640 G1 = y
2650 GOSUB 2170
2660 Z2 = T
2670 K1 = J + 1
2680 PRINT : IF NFM1$ = "" THEN NFM1$ = Name2$
2690 LOCATE 14, 16: PRINT "What is person two's name? "; NFM1$ + STRING$(10, 32); : LOCATE CSRLIN, 44: LINE INPUT B1$: IF B1$ = "" THEN B1$ = NFM1$
2700 Ne$ = B1$: Name2$ = Ne$
2710 GOSUB 3760
2720 B1$ = Ne$
2730 NFM1$ = B1$
2750 GOSUB 3460
2760 IF DT1 > 0 THEN SWAP B1$, N2$
2770 IF DT1 > 0 THEN m = DT1: DD = DT2: y = DT3: DT1 = 0: GOTO 2860
2775 GOSUB 3910
2776 IF WF$ = "N" THEN 2790
2780 LOCATE 15, 16: PRINT "ENTER GENDER: " + STRING$(50, 32); : LOCATE , 30: LINE INPUT Gender$: GOSUB 3870
2790 LOCATE 15, 16: PRINT "What is "; B1$; "'s ";
2800 INPUT "birthday (MM,DD,YYYY)"; m, DD, y: IF LEN(LTRIM$(STR$(y))) < 4 THEN 2790
2810 IF m < 10 THEN AD3$ = "0" + RIGHT$(STR$(m), 1) ELSE AD3$ = RIGHT$(STR$(m), 2)
2820 IF DD < 10 THEN AD4$ = "0" + RIGHT$(STR$(DD), 1) ELSE AD4$ = RIGHT$(STR$(DD), 2)
2830 AD1$ = B1$: AD2$ = AD3$ + "-" + AD4$ + "-" + RIGHT$(STR$(y), 4)
2840 IF WF$ = "N" THEN 2860
2850 GOSUB 3640
2860 E2 = m
2870 D2 = DD
2880 G2 = y
2890 GOSUB 2170
2900 P2 = ABS(Z2 - T)
2910 K2 = J + 1
2930 COLOR 7, 0: CLS : ' BLOAD PATH$ + "biocomp.ovl"
2950 LOCATE 11, 28: COLOR LGreen: PRINT A1$; " and "; B1$; "."; : COLOR LGRAY
2960 LOCATE 13, 15: COLOR LGreen: PRINT A1$; : COLOR LGRAY: PRINT " was born on ";
2970 B9 = K1
2980 GOSUB 2110
2990 COLOR LRed: PRINT AY$; : COLOR LGRAY: PRINT ", ";
3000 A9 = E1
3010 GOSUB 2080
3020 PRINT MT$;
3030 PRINT STR$(F1); ","; G1;
3040 LOCATE 14, 15: COLOR LGreen: PRINT B1$; : COLOR LGRAY: PRINT " was born on ";
3050 B9 = K2
3060 GOSUB 2110
3070 COLOR LRed: PRINT AY$; : COLOR LGRAY: PRINT ", ";
3080 A9 = E2
3090 GOSUB 2080
3100 PRINT MT$;
3110 PRINT STR$(D2); ","; G2;
3130 Z = P2
3150 P3 = ABS(INT(((Z / 23) - INT(Z / 23)) * 23))
3160 S3 = ABS(INT(((Z / 28) - INT(Z / 28)) * 28))
3170 C3 = ABS(INT(((Z / 33) - INT(Z / 33)) * 33))
3180 P5 = ABS(100 - ((2 * P3) * (100 / 23)))
3190 S5 = ABS(100 - ((2 * S3) * (100 / 28)))
3200 C5 = ABS(100 - ((2 * C3) * (100 / 33)))
3210 COLOR LRed: LOCATE 16, 55: PRINT USING CP$; P5
3220 COLOR Cyan: LOCATE 17, 55: PRINT USING CP$; S5
3230 COLOR Yellow: LOCATE 18, 55: PRINT USING CP$; C5
3250 LOCATE 20, 55
3260 A5 = (P5 + S5 + C5) / 3
3270 COLOR Magenta: PRINT USING CP$; A5; : COLOR LGRAY
3280 IF ELine = 43 THEN LastLine = 18
IF ELine = 25 THEN LastLine = 0
IF ELine = 50 THEN LastLine = 25
3290 GOTO 1990
3300 CLOSE : SYSTEM: ' RUN "BioRhyth.Exe"
3310 CLS : SYSTEM: 'RUN "BIORHYTH.EXE"
3320 LOCATE UU + 1, UUU + 1: PRINT STRING$(LEN(ab$), 32); : LOCATE UU + 1, UUU + 1
3340 ab$ = ""
3350 FOR I = 0 TO U
3360 m$ = INPUT$(1)
3370 IF m$ = CHR$(13) THEN 3420
IF m$ = CHR$(29) THEN 3320
3380 IF m$ = CHR$(8) THEN m$ = CHR$(29): GOTO 3320
IF (m$ = " ") + (m$ = "'") THEN 3390
3385 IF (ASC(UCASE$(m$)) < 48) + (ASC(UCASE$(m$)) > 90) THEN BEEP: GOTO 3360
3390 ab$ = ab$ + m$
3400 LOCATE UU + 1, UUU + I + 1: PRINT m$;
3410 NEXT I
3420 IF U = 3 THEN
IF (LEN(ab$)) < 4 THEN 3320
END IF
IF U < 3 AND m$ = CHR$(13) THEN 3440
3430 IF U < 3 THEN PRINT "-"; ELSE PRINT
3440 RETURN
3460 'CLOSE #1: OPEN "R", 1, pat2$ + "BIO.DAT", 60
3470 'N1$ = ""
3480 'FIELD 1, 30 AS N1$, 10 AS D1$, 8 AS D2$, 6 AS GE$, 1 AS DL$
3490 'DT1 = 0
3500 'GH = ASC(Ne$) - 64
3510 'FOR SE = Start(GH) TO FINISH(GH)
3520 'IF EOF(1) THEN 3620
3530 'GET 1, SE
3540 'IF LEFT$(N1$, 2) = "%%" THEN 3620
3550 'IF DL$ = "I" THEN PIX = SE: GOTO 3580
3570 'IF INSTR(1, N1$, Ne$) <> 0 THEN 3590
3580 'NEXT SE
3590 'N2$ = LEFT$(N1$, INSTR(1, N1$, " ") - 1)
3600 'Ne$ = N2$
3610 'DT1 = VAL(MID$(D1$, 1, 2)): DT2 = VAL(MID$(D1$, 4, 2)): DT3 = VAL(RIGHT$(D1$, 4))
3620 'CLOSE #1
3630 RETURN
3640 ON ERROR GOTO 3900
3650 'CLOSE 1: OPEN "R", 1, pat2$ + "BIO.DAT", 60
'FIELD 1, 30 AS N1$, 10 AS D1$, 8 AS D2$, 6 AS GE$, 1 AS DL$
3660 'IF PIX THEN SE = PIX
3670 'PIX = 0
3680 'LSET N1$ = AD1$
3690 'LSET D1$ = AD2$
3700 'LSET D2$ = LEFT$(DATE$, 6) + RIGHT$(DATE$, 2)
3710 'LSET GE$ = Gender$
3720 'LSET DL$ = "A"
3730 'PUT 1, SE
3740 'CLOSE #1
3750 RETURN
3760 FOR I = 1 TO LEN(Ne$)
3770 S1$ = MID$(Ne$, I, 1)
3780 IF I = 1 THEN S1$ = MID$(Ne$, I, 1): IF S1$ < CHR$(97) OR S1$ > CHR$(122) THEN 3820 ELSE MID$(Ne$, I, 1) = CHR$(ASC(S1$) - 32)
3790 IF S1$ = " " THEN I = I + 1: S1$ = MID$(Ne$, I, 1): IF S1$ < CHR$(97) OR S1$ > CHR$(122) THEN 3820 ELSE MID$(Ne$, I, 1) = CHR$(ASC(S1$) - 32)
3800 IF S1$ < CHR$(65) OR S1$ > CHR$(91) THEN 3820
3810 MID$(Ne$, I, 1) = CHR$(ASC(S1$) + 32)
3820 NEXT I
3830 RETURN
3840 CLOSE : ' OPEN "O", 1, "BIOCHAIN.CFG": PRINT #1, "2": CLOSE #1
3850 CLS : LOCATE 12, 31: PRINT "Loading Editor...";
3860 SYSTEM: 'RUN "BioEdit.Prg"
3861 SYSTEM: 'CLOSE : CLS : LOCATE 12, 31: PRINT "Loading Printout Program...": RUN "BioPrint.prg"

3870 IF Gender$ = "" THEN Gender$ = "E"
3875 MID$(Gender$, 1, 1) = UCASE$(LEFT$(Gender$, 1)): MID$(Gender$, 2) = LCASE$(MID$(Gender$, 2))
3890 RETURN
3900 RESUME NEXT
3910 BEEP: NOF$ = " is not on file. Do you want to file (Y/N) ?"
LOCATE 23, 1: PRINT Ne$; NOF$;
3911 WF$ = UCASE$(INKEY$): IF WF$ = "" THEN 3911
3916 IF INSTR("YN", WF$) = 0 THEN 3911
LOCATE 23, 1: PRINT STRING$(79, 32);
3920 RETURN
'end of program lines

Title: Re: Coding Conversion Problem
Post by: bplus on June 03, 2020, 05:30:12 pm

See if this works:

Code: QB64: [Select]

DIM SHARED V
DIM SHARED P#
'----------------------FUNCTION 1 DEFINITION BEGIN  LINE 460
'----------------------FUNCTION 2 DEFINITION BEGIN LINE 1770
'
1 ' BioGraph.Bas, (C) 1985-2020, GEORGE A LEE, BioRhythm, (575) 623-8365
CDate$ = "1985-2020"
version$ = "Version. 4.0"
Hit = 0
KEY OFF
ON ERROR GOTO FIXIT
ELine = 50
2 WIDTH 80, ELine
GOTO 6
FIXIT:
IF ELine = 50 THEN ELine = 43: RESUME 2
IF ELine = 43 THEN ELine = 25: RESUME 3
RESUME NEXT
3 ELine = 25
6 WIDTH 80, 25
14 KEY OFF
15 LGreen = 10: LGRAY = 7: Cyan = 11: LRed = 12: Magenta = 13: Yellow = 14
20 DIM CR$(26), Start(26), FINISH(26)
30 C = 9
40 FOR I = 1 TO 26
    50 CR$(I) = CHR$(64 + I)
    60 Start(I) = C + 1
    70 FINISH(I) = C + 100
    80 C = C + 100
90 NEXT I
100 ON ERROR GOTO 3900
110 CLS
120 LOCATE 6, 1, 0
140 CP$ = "###.##%"
X$ = version$
Hit = 0
200 FOR Delay = 1 TO 3000: NEXT Delay: CLS: WIDTH 80
220 DIM A(12), D(12)
230 CLS
235 'WIDTH 80, 25: VIEW PRINT 1 TO ELine: LOCATE , , 0
'IF pcpy AND ELine = 25 THEN PCOPY 1, 0: GOTO 370
236 'BLOAD PATH$ + "biograph.ov1": PCOPY 0, 1: pcpy = 1
237 GOTO 370
240 PRINT "BIO-RHYTHMS"; TAB(51); "(c) "; CDate$; " by George A. Lee"
250 FOR B = .2 TO 3 STEP .2
    270 y = SIN(B)
    280 PRINT TAB(20 * y + 9); CHR$(1);
    290 PRINT TAB(40 * y + 10); CHR$(3);
    300 PRINT TAB(50 * y + 10); CHR$(215);
    310 ' formula from 'COMPUTER GAMES',J.V.NAHIGIAN,W.S.HODGES
    320 ' formula translated to Model 4 by GEORGE A. LEE, 12/85
330 NEXT B
340 PRINT
350 PRINT "This program can chart your daily BIO-RHYTHMIC patterns, or determine compat-"
360 PRINT "ability of two individuals.": PRINT STRING$(80, "-");
370 FOR I = 1 TO 12
    380 READ A(I)
390 NEXT I
400 FOR I = 1 TO 12
    410 READ D(I)
420 NEXT I
430 DATA 0,31,59,90,120,151,181,212,243,273,304,334
440 DATA 31,28,31,30,31,30,31,31,30,31,30,31
 
'----------------------FUNCTION 1 DEFINITION BEGIN--------------------------------
'460 DEF FNA (Z) = CDBL(INT((SIN((V / Z - INT(V / Z)) * P#) + 1) * 13.5))
'470 DEF FNG (Z) = 100 * SIN(V / Z * P#)
'480 DEF FNB = V - 28 * INT(V / 28) + 1
'490 DEF FNC = V - 23 * INT(V / 23) + 1
'500 DEF FND = V - 33 * INT(V / 33) + 1
'----------------------FUNCTION 1 DEFINITION END--------------------------------
 
505 WF$ = ""
506 'GOTO 550
510 LOCATE 19, 1
515 PRINT "<1>  Single person chart"
520 PRINT "<2>  Two person compatability"
530 PRINT "<3>  End program"
540 PRINT "<4>  EDIT file"
550 ED$ = "4"
LOCATE 23, 1: COLOR Yellow: PRINT "<";: COLOR Magenta: PRINT "5";: COLOR Yellow: PRINT ">";: COLOR Cyan: PRINT "  OOPs, Wanted Printer Verson"
KY$ = INPUT$(1): IF INSTR("1235" + ED$, KY$) = 0 THEN 550
560 KY = VAL(KY$): LOCATE , , 1
570 ON KY GOTO 580, 2370, 3300, 3840, 3861
575 NFME$ = TempName$: TempName$ = ""
580 FOR I = 0 TO 4: LOCATE 19 + I, 1: PRINT SPACE$(60);: NEXT I: LOCATE 19, 1: I = 0
585 IF LEFT$(NFME$, 1) = "m" OR LEFT$(NFME$, 1) = CHR$(0) THEN NFME$ = Ne$
590 COLOR Yellow, 0: PRINT "Name on chart: "; NFME$ + STRING$(10, 32);: COLOR 7: LOCATE 19, 16: LINE INPUT Ne$: IF Ne$ = "" THEN Ne$ = NFME$
600 GOSUB 3760: LOCATE 19, 16: PRINT STRING$(27, 32), ;: LOCATE 19, 16: PRINT Ne$;
610 NFME$ = Ne$: Name1$ = Ne$
620 'IF WF$="N" THEN 660
630 GOSUB 3460
640 NFME$ = N1$
650 YB = VAL(MID$(DT1$, 7))
660 COLOR Cyan, 1: CLS: LOCATE 1, 1: PRINT "This chart specifically printed for "; Ne$; "."
670 PRINT "Compiled on "; DATE$; "      -     "; "(c) "; CDate$; " by George A. Lee"
680 COLOR LRed: PRINT TAB(12); "Biorhythm is the rhythmic course of the life process of an individual."
690 PRINT: COLOR Yellow: PRINT "The MEDIAN, line (0), is the critical and is when most accidents MAY occur.": PRINT TAB(12); "The high periods (+) are when you have the most energy, and the low"
700 PRINT TAB(12); "periods (-) are regarded as recuperative periods.": COLOR Cyan
710 LOCATE 21, 1: PRINT STRING$(80, 32);: LOCATE 22, 1: PRINT STRING$(80, 32);
715 LOCATE 21, 1: COLOR LGreen
PRINT "STARTING DATE FOR CHART? (Default=";
COLOR 15: PRINT DATE$;: COLOR LGreen: PRINT ") ";
Sharon1 = POS(Sharon1) + 1: LOCATE , Sharon1: PRINT "   -  -";: COLOR Cyan
720 LOCATE , Sharon1: UUU = Sharon1: UU = 20: U = 1: GOSUB 3320: m = VAL(ab$): IF m <= 0 THEN m = VAL(DATE$): DD = VAL(MID$(DATE$, 4, 2)): y = VAL(RIGHT$(DATE$, 4)): LOCATE CSRLIN, Sharon1: PRINT DATE$: GOTO 760
730 IF (m <= 0) + (m > 12) THEN BEEP: GOTO 720
Sharon2 = Sharon1 + 3
740 LOCATE , Sharon2: U = 1: UUU = Sharon2: GOSUB 3320: DD = VAL(ab$): IF (DD <= 0) + (DD > 31) THEN BEEP: GOTO 740
750 LOCATE , Sharon2 + 3: U = 3: UUU = Sharon2 + 3: GOSUB 3320: IF ab$ = "" THEN BEEP: GOTO 750
y = VAL(ab$)
760 ab$ = ""
780 IF YS > YB THEN 1130
800 DTP = ELine: '15.5
810 M2 = m
820 D2 = DD
830 Y3 = y
840 Y5 = y
850 GOSUB 2170
860 Z = T
870 PRINT
880 IF DT1 > 0 THEN m = DT1: DD = DT2: y = DT3: DT1 = 0: GOTO 1020
886 GOSUB 3910
887 IF WF$ = "N" THEN 910
EGEN$ = "ENTER " + UCASE$(Ne$) + "'S GENDER: "
890 LOCATE 23, 1: PRINT EGEN$ + STRING$(60 - LEN(Ne$), 32);: LOCATE 23, LEN(EGEN$) + 2: LINE INPUT Gender$: LOCATE 23, 1: PRINT STRING$(60, 32);
900 GOSUB 3870
910 IF WF$ = "N" THEN NFME$ = Ne$
915 LOCATE 23, 1: PRINT SPC(70);
916 LOCATE 23, 1: PRINT "ENTER "; UCASE$(Ne$); "'S BIRTHDATE (";: COLOR 15: PRINT "MM-DD-YYYY";: COLOR Cyan: PRINT ") ";
Sharon1 = POS(Sharon1) + 1: LOCATE , Sharon1: PRINT "   -  -";
920 LOCATE , Sharon1: UUU = Sharon1: U = 1: UU = CSRLIN - 1: GOSUB 3320: m = VAL(ab$): IF (m <= 0) + (m > 12) THEN BEEP: GOTO 920
930 AD3$ = ab$ + "-": EY$ = ab$: ab$ = "": Sharon2 = Sharon1 + 3
940 LOCATE , Sharon2: U = 1: UUU = Sharon2: GOSUB 3320: DD = VAL(ab$): IF (DD <= 0) + (DD > 31) THEN BEEP: GOTO 940
950 AD4$ = ab$ + "-": EY$ = EY$ + ab$: ab$ = ""
960 LOCATE , Sharon2 + 3: U = 3: UUU = Sharon2 + 3: GOSUB 3320: IF ab$ = "" THEN BEEP: GOTO 960
970 y = VAL(ab$)
UUU = 0
ab$ = RIGHT$(STR$(y), 4)
980 AD2$ = AD3$ + AD4$ + ab$
990 AD1$ = Ne$
1000 IF WF$ = "N" THEN 1020
1010 GOSUB 3640
1020 PRINT "Any changes (Y/N) ? ";
1030 YN$ = INPUT$(1): IF (YN$ = "Y") + (YN$ = "y") THEN TempName$ = Ne$: GOTO 575 ELSE IF (YN$ = "N") + (YN$ = "n") THEN 1050
1040 GOTO 1030
1050 COLOR 7, 0: ab$ = ""
1060 M1 = m
1070 D1 = DD
1080 Y2 = y
1085 GOTO 1140
1100 IF AD1$ <> "" THEN 1140
1130 LOCATE 23, 1: PRINT "******* Don't try to kid me, You weren't born yet!!!! Try again.": PRINT SPACE$(50);: FOR Delay = 1 TO 1000: NEXT Delay: GOTO 580
1140 GOSUB 2170
1145 IF T > Z THEN 1130
1150 V = T - Z
1160 V = ABS(V)
1180 IF ELine > 25 THEN WIDTH 80, ELine
VIEW PRINT 1 TO ELine: COLOR Cyan, 1: CLS
1190 PRINT "GRAPH SYMBOLS:  ";: COLOR 12: PRINT CHR$(3);: COLOR 15: PRINT " Physical Cycle (23 day)";
COLOR Yellow: PRINT TAB(51); "(c)"; CDate$; " by George A. Lee"
1200 COLOR 10: PRINT TAB(17); CHR$(1);: COLOR 15: PRINT " Sensitivity (emotional) Cycle (28 day)"
1210 COLOR 11: PRINT TAB(17); CHR$(251);: COLOR 15: PRINT " Cognitive (intellectual) Cycle (33 day)"
1220 COLOR 12: PRINT TAB(17); "**";: COLOR 15: PRINT " Critical day.  Most accidents MAY occur."
1230 IF INSTR(Ne$, " ") <= 0 THEN IST = LEN(Ne$) ELSE IST = INSTR(Ne$, " ") - 1
1240 COLOR LGreen: PRINT LEFT$(Ne$, IST); ", "; "you were born on ";
1250 B9 = J + 1
1260 GOSUB 2110
1270 PRINT AY$; ", ";
1280 A9 = M1
1290 GOSUB 2080
1300 PRINT MT$;
1310 PRINT STR$(D1) + ","; Y2; "-";
1320 PRINT USING " ######, days OR ###.# years ago."; V; V / 365.25#: PRINT
1340 m$ = "DATE            (-)       (0)       (+)            CAPABILITY %-TILE"
1350 y = 5
1360 X = 0
1370 COLOR 10, 1: LOCATE 6, 1: LOCATE 6, 59: PRINT CHR$(1);: COLOR 11: PRINT "      " + CHR$(251);: COLOR 12: PRINT "      " + CHR$(3) + "     **";: COLOR 15
1380 LOCATE 7, 7: PRINT m$: COLOR 7
1390 J1 = V + J
1400 J1 = J1 - 7 * INT(J1 / 7)
1410 D2 = D2 - 1
1420 J1 = J1 - 1
1430 V = V - 1
1450 FOR I = 1 TO DTP - 9
    1455 K = 0
    1460 V = V + 1
    1470 D2 = D2 + 1
    1480 J1 = J1 + 1
    1490 IF M2 <> 2 THEN 1520
    1500 IF INT(Y3 / 4) <> Y3 / 4 THEN 1520
    1510 K = 1
    1520 IF D2 <= D(M2) + K THEN 1550
    1530 M2 = M2 + 1
    1540 D2 = 1
    1550 IF J1 < 7 THEN 1570
    1560 J1 = 0
    1570 IF M2 <= 12 THEN 1620
    1580 Happy$ = "* HAPPY NEW YEAR *"
    1590 Happy = 1
    1600 M2 = 1
    1610 Y3 = Y3 + 1
    1620 IF M2 <> M1 THEN 1670
    1630 IF D2 <> D1 THEN 1670
    1640 Happy$ = "*HAPPY" + STR$(Y3 - Y2) + " BIRTHDAY*"
    1650 Happy = 1
    1660 'PUT 'HAPPY BIRTHDAY' SONG IN HERE
    1670 IF M2 <> 12 THEN 1710
    1680 IF D2 <> 25 THEN 1710
    1690 Happy$ = "* MERRY CHRISTMAS *"
    1700 Happy = 1
    1710 m$ = STR$(M2) + "-" + STR$(D2)
    1720 IF VAL(RIGHT$(STR$(Y3), 4)) < 10 THEN YR1$ = "000" + RIGHT$(STR$(Y3), 1) ELSE YR1$ = RIGHT$(STR$(Y3), 4)
    1730 COLOR 14: LOCATE 7 + I, 1: PRINT USING " ##_-##_-\  \"; M2; D2; YR1$: COLOR 7
    1750 G = 20
    1760 P# = 6.28318530717961#
 
    '----------------------FUNCTION2 DEFINITION BEGIN--------------------------------
    1770 C5 = FNA(33) + G
    1780 S5 = FNA(28) + G
    1790 P5 = FNA(23) + G
    1800 LOCATE 7 + I, 34: PRINT CHR$(179);
    1810 CH1$ = CHR$(2): CH2$ = CHR$(1)
    1820 IF S5 > 33 THEN SWAP CH1$, CH2$
    1830 LOCATE 7 + I, S5 + 1: COLOR 10: PRINT CH2$;
    1840 LOCATE 7 + I, 57: PRINT USING "####"; FNG(28);: COLOR 7
 
    1850 LOCATE 7 + I, C5 + 1: COLOR 11: PRINT CHR$(251);
    1860 LOCATE 7 + I, 64: PRINT USING "####"; FNG(33);: COLOR 7
 
    1870 LOCATE 7 + I, P5 + 1: COLOR 12: PRINT CHR$(3);
    1880 LOCATE 7 + I, 71: PRINT USING "####"; FNG(23);: COLOR 7
 
    1890 IF (S5 = 33) + (P5 = 33) + (C5 = 33) THEN LOCATE 7 + I, 79: COLOR 12 + 16: PRINT "**";: COLOR 7
 
    1900 IF FNG(28) = FNG(33) THEN LOCATE 7 + I, S5 + 1: PRINT " ";
    1910 IF FNG(28) = FNG(23) THEN LOCATE 7 + I, S5 + 1: PRINT " ";
    1920 IF FNG(23) = FNG(33) THEN LOCATE 7 + I, P5 + 1: PRINT " ";
    '----------------------FUNCTION2 DEFINITION END--------------------------------
 
 
 
    1930 IF Happy THEN GOSUB 2130
    1940 IF M2 <> 1 THEN 1980
    1950 IF D2 <> 1 THEN 1980
    1960 m$ = "* HAPPY NEW YEAR *"
    1970 GOSUB 2140
1980 NEXT I
1990 m$ = "Another chart? (Y/n) "
2000 LOCATE ELine - LastLine, 1: PRINT STRING$(70, 32);
2010 LOCATE ELine - LastLine, 1: COLOR 15: PRINT m$;
LastLine = 0
COLOR 7, 0
2020 KY$ = INKEY$
2030 IF KY$ = "" THEN 2020
2040 IF UCASE$(KY$) = "N" THEN CLS: GOTO 3300
2050 IF UCASE$(KY$) = "Y" THEN CLOSE: CLS: RUN
GOTO 2020
2060 CLS: CLOSE: LOCATE , , 0: SYSTEM 'RUN "BIORHYTH.EXE"
2080 MONTH$ = "JanFebMarAprMayJunJulAugSepOctNovDec"
2090 MT$ = MID$(MONTH$, A9 * 3 - 2, 3)
2100 RETURN
2110 DDAY$ = "WedThuFriSatSunMonTue"
2120 AY$ = MID$(DDAY$, B9 * 3 - 2, 3): RETURN
2130 IF Happy THEN SWAP m$, Happy$
2140 LOCATE 7 + I, 1:
IF Happy THEN COLOR LGreen + 16
PRINT m$;
COLOR 7
2150 Happy = 0
2160 RETURN
2170 y1 = y - 1800
2180 Q1 = INT(y1 / 4)
2190 Q2 = INT(Q1 / 25)
2200 Q3 = INT((y1 + 200) / 400)
2210 K = 0
2220 IF Q1 * 4 <> y1 THEN 2260
2230 IF Q2 * 100 <> y1 THEN 2260
2240 IF Q3 * 400 - 200 <> y1 THEN 2260
2250 K = 1
2260 T = 365 * y1 + Q1 - Q2 + Q3 - K
2270 T = T + A(m) + DD - 1
2280 IF m < 3 THEN 2300
2290 T = T + K
2300 IF INT(y1 / 4) <> y1 / 4 THEN 2330
2310 IF m > 2 THEN 2330
2320 T = T - 1
2330 J = T - 7 * INT(T / 7)
2340 RETURN
2350 END
2370 COLOR Cyan, 1: CLS
2380 PRINT "                 C O M P A T A B I L I T Y    A N A L Y S I S"
2390 PRINT
COLOR Yellow
2400 PRINT "          Two individuals will have an average compatability of 100%"
2410 PRINT "       ONLY if they were born on the same day, or if they were born"
2420 PRINT "       21,252 days (58.1848 Years) apart.  ";
2430 PRINT "Please do not be upset if": PRINT "       your compatability average is less than 100%!"
2440 PRINT: IF NFME$ = "" THEN NFME$ = Name1$
COLOR Cyan
2460 LOCATE 10, 16: PRINT "What is person one's name?  "; NFME$ + STRING$(8, 32);: LOCATE CSRLIN, 44: LINE INPUT A1$: IF A1$ = "" THEN A1$ = NFME$
2470 Ne$ = A1$: Name1$ = Ne$
2480 GOSUB 3760
2490 A1$ = Ne$
2500 NFME$ = A1$
2510 'IF INSTR(A1$," ")>0 THEN 2550
2520 GOSUB 3460
2530 IF DT1 > 0 THEN SWAP A1$, N2$
2540 IF DT1 > 0 THEN m = DT1: DD = DT2: y = DT3: DT1 = 0: GOTO 2620
2542 GOSUB 3910
2543 IF WF$ = "N" THEN 2560
2550 LOCATE 11, 16: PRINT "ENTER GENDER: ";: LINE INPUT Gender$: GOSUB 3870
2560 LOCATE 11, 16: PRINT "What is "; A1$; "'s ";
INPUT "birthday (MM,DD,YYYY)"; m, DD, y: IF LEN(LTRIM$(STR$(y))) < 4 THEN 2560
2570 IF m < 10 THEN AD3$ = "0" + RIGHT$(STR$(m), 1) ELSE AD3$ = RIGHT$(STR$(m), 2)
2580 IF DD < 10 THEN AD4$ = "0" + RIGHT$(STR$(DD), 1) ELSE AD4$ = RIGHT$(STR$(DD), 2)
2590 AD1$ = A1$: AD2$ = AD3$ + "-" + AD4$ + "-" + RIGHT$(STR$(y), 4)
2600 IF WF$ = "N" THEN 2620
2610 GOSUB 3640
2620 E1 = m
2630 F1 = DD
2640 G1 = y
2650 GOSUB 2170
2660 Z2 = T
2670 K1 = J + 1
2680 PRINT: IF NFM1$ = "" THEN NFM1$ = Name2$
2690 LOCATE 14, 16: PRINT "What is person two's name?  "; NFM1$ + STRING$(10, 32);: LOCATE CSRLIN, 44: LINE INPUT B1$: IF B1$ = "" THEN B1$ = NFM1$
2700 Ne$ = B1$: Name2$ = Ne$
2710 GOSUB 3760
2720 B1$ = Ne$
2730 NFM1$ = B1$
2750 GOSUB 3460
2760 IF DT1 > 0 THEN SWAP B1$, N2$
2770 IF DT1 > 0 THEN m = DT1: DD = DT2: y = DT3: DT1 = 0: GOTO 2860
2775 GOSUB 3910
2776 IF WF$ = "N" THEN 2790
2780 LOCATE 15, 16: PRINT "ENTER GENDER: " + STRING$(50, 32);: LOCATE , 30: LINE INPUT Gender$: GOSUB 3870
2790 LOCATE 15, 16: PRINT "What is "; B1$; "'s ";
2800 INPUT "birthday  (MM,DD,YYYY)"; m, DD, y: IF LEN(LTRIM$(STR$(y))) < 4 THEN 2790
2810 IF m < 10 THEN AD3$ = "0" + RIGHT$(STR$(m), 1) ELSE AD3$ = RIGHT$(STR$(m), 2)
2820 IF DD < 10 THEN AD4$ = "0" + RIGHT$(STR$(DD), 1) ELSE AD4$ = RIGHT$(STR$(DD), 2)
2830 AD1$ = B1$: AD2$ = AD3$ + "-" + AD4$ + "-" + RIGHT$(STR$(y), 4)
2840 IF WF$ = "N" THEN 2860
2850 GOSUB 3640
2860 E2 = m
2870 D2 = DD
2880 G2 = y
2890 GOSUB 2170
2900 P2 = ABS(Z2 - T)
2910 K2 = J + 1
2930 COLOR 7, 0: CLS: ' BLOAD PATH$ + "biocomp.ovl"
2950 LOCATE 11, 28: COLOR LGreen: PRINT A1$; " and "; B1$; ".";: COLOR LGRAY
2960 LOCATE 13, 15: COLOR LGreen: PRINT A1$;: COLOR LGRAY: PRINT " was born on ";
2970 B9 = K1
2980 GOSUB 2110
2990 COLOR LRed: PRINT AY$;: COLOR LGRAY: PRINT ", ";
3000 A9 = E1
3010 GOSUB 2080
3020 PRINT MT$;
3030 PRINT STR$(F1); ","; G1;
3040 LOCATE 14, 15: COLOR LGreen: PRINT B1$;: COLOR LGRAY: PRINT " was born on ";
3050 B9 = K2
3060 GOSUB 2110
3070 COLOR LRed: PRINT AY$;: COLOR LGRAY: PRINT ", ";
3080 A9 = E2
3090 GOSUB 2080
3100 PRINT MT$;
3110 PRINT STR$(D2); ","; G2;
3130 Z = P2
3150 P3 = ABS(INT(((Z / 23) - INT(Z / 23)) * 23))
3160 S3 = ABS(INT(((Z / 28) - INT(Z / 28)) * 28))
3170 C3 = ABS(INT(((Z / 33) - INT(Z / 33)) * 33))
3180 P5 = ABS(100 - ((2 * P3) * (100 / 23)))
3190 S5 = ABS(100 - ((2 * S3) * (100 / 28)))
3200 C5 = ABS(100 - ((2 * C3) * (100 / 33)))
3210 COLOR LRed: LOCATE 16, 55: PRINT USING CP$; P5
3220 COLOR Cyan: LOCATE 17, 55: PRINT USING CP$; S5
3230 COLOR Yellow: LOCATE 18, 55: PRINT USING CP$; C5
3250 LOCATE 20, 55
3260 A5 = (P5 + S5 + C5) / 3
3270 COLOR Magenta: PRINT USING CP$; A5;: COLOR LGRAY
3280 IF ELine = 43 THEN LastLine = 18
IF ELine = 25 THEN LastLine = 0
IF ELine = 50 THEN LastLine = 25
3290 GOTO 1990
3300 CLOSE: SYSTEM: ' RUN "BioRhyth.Exe"
3310 CLS: SYSTEM: 'RUN "BIORHYTH.EXE"
3320 LOCATE UU + 1, UUU + 1: PRINT STRING$(LEN(ab$), 32);: LOCATE UU + 1, UUU + 1
3340 ab$ = ""
3350 FOR I = 0 TO U
    3360 m$ = INPUT$(1)
    3370 IF m$ = CHR$(13) THEN 3420
    IF m$ = CHR$(29) THEN 3320
    3380 IF m$ = CHR$(8) THEN m$ = CHR$(29): GOTO 3320
    IF (m$ = " ") + (m$ = "'") THEN 3390
    3385 IF (ASC(UCASE$(m$)) < 48) + (ASC(UCASE$(m$)) > 90) THEN BEEP: GOTO 3360
    3390 ab$ = ab$ + m$
    3400 LOCATE UU + 1, UUU + I + 1: PRINT m$;
3410 NEXT I
3420 IF U = 3 THEN
    IF (LEN(ab$)) < 4 THEN 3320
END IF
IF U < 3 AND m$ = CHR$(13) THEN 3440
3430 IF U < 3 THEN PRINT "-"; ELSE PRINT
3440 RETURN
3460 'CLOSE #1: OPEN "R", 1, pat2$ + "BIO.DAT", 60
3470 'N1$ = ""
3480 'FIELD 1, 30 AS N1$, 10 AS D1$, 8 AS D2$, 6 AS GE$, 1 AS DL$
3490 'DT1 = 0
3500 'GH = ASC(Ne$) - 64
3510 'FOR SE = Start(GH) TO FINISH(GH)
3520 'IF EOF(1) THEN 3620
3530 'GET 1, SE
3540 'IF LEFT$(N1$, 2) = "%%" THEN 3620
3550 'IF DL$ = "I" THEN PIX = SE: GOTO 3580
3570 'IF INSTR(1, N1$, Ne$) <> 0 THEN 3590
3580 'NEXT SE
3590 'N2$ = LEFT$(N1$, INSTR(1, N1$, "  ") - 1)
3600 'Ne$ = N2$
3610 'DT1 = VAL(MID$(D1$, 1, 2)): DT2 = VAL(MID$(D1$, 4, 2)): DT3 = VAL(RIGHT$(D1$, 4))
3620 'CLOSE #1
3630 RETURN
3640 ON ERROR GOTO 3900
3650 'CLOSE 1: OPEN "R", 1, pat2$ + "BIO.DAT", 60
'FIELD 1, 30 AS N1$, 10 AS D1$, 8 AS D2$, 6 AS GE$, 1 AS DL$
3660 'IF PIX THEN SE = PIX
3670 'PIX = 0
3680 'LSET N1$ = AD1$
3690 'LSET D1$ = AD2$
3700 'LSET D2$ = LEFT$(DATE$, 6) + RIGHT$(DATE$, 2)
3710 'LSET GE$ = Gender$
3720 'LSET DL$ = "A"
3730 'PUT 1, SE
3740 'CLOSE #1
3750 RETURN
3760 FOR I = 1 TO LEN(Ne$)
    3770 S1$ = MID$(Ne$, I, 1)
    3780 IF I = 1 THEN S1$ = MID$(Ne$, I, 1): IF S1$ < CHR$(97) OR S1$ > CHR$(122) THEN 3820 ELSE MID$(Ne$, I, 1) = CHR$(ASC(S1$) - 32)
    3790 IF S1$ = " " THEN I = I + 1: S1$ = MID$(Ne$, I, 1): IF S1$ < CHR$(97) OR S1$ > CHR$(122) THEN 3820 ELSE MID$(Ne$, I, 1) = CHR$(ASC(S1$) - 32)
    3800 IF S1$ < CHR$(65) OR S1$ > CHR$(91) THEN 3820
    3810 MID$(Ne$, I, 1) = CHR$(ASC(S1$) + 32)
3820 NEXT I
3830 RETURN
3840 CLOSE: ' OPEN "O", 1, "BIOCHAIN.CFG": PRINT #1, "2": CLOSE #1
3850 CLS: LOCATE 12, 31: PRINT "Loading Editor...";
3860 SYSTEM: 'RUN "BioEdit.Prg"
3861 SYSTEM: 'CLOSE : CLS : LOCATE 12, 31: PRINT "Loading Printout Program...": RUN "BioPrint.prg"
 
3870 IF Gender$ = "" THEN Gender$ = "E"
3875 MID$(Gender$, 1, 1) = UCASE$(LEFT$(Gender$, 1)): MID$(Gender$, 2) = LCASE$(MID$(Gender$, 2))
3890 RETURN
3900 RESUME NEXT
3910 BEEP: NOF$ = " is not on file.  Do you want to file (Y/N) ?"
LOCATE 23, 1: PRINT Ne$; NOF$;
3911 WF$ = UCASE$(INKEY$): IF WF$ = "" THEN 3911
3916 IF INSTR("YN", WF$) = 0 THEN 3911
LOCATE 23, 1: PRINT STRING$(79, 32);
3920 RETURN
 
FUNCTION FNA (Z)
    FNA = CDBL(INT((SIN((V / Z - INT(V / Z)) * P#) + 1) * 13.5))
END FUNCTION
FUNCTION FNG (Z)
    FNG = 100 * SIN(V / Z * P#)
END FUNCTION
FUNCTION FNB ()
    FNB = V - 28 * INT(V / 28) + 1
END FUNCTION
FUNCTION FNC ()
    FNC = V - 23 * INT(V / 23) + 1
END FUNCTION
FUNCTION FND
    FND = V - 33 * INT(V / 33) + 1
END FUNCTION
 
 
 

Title: Re: Coding Conversion Problem
Post by: Cobalt on June 03, 2020, 07:24:11 pm

I just converted the functions, I did give thought to keeping them inline with code. I think B+ has it.

Title: Re: Coding Conversion Problem
Post by: GeorgeLee on June 03, 2020, 07:29:57 pm

Thank You!, Thank You!, Thank You! I looked over the code and haven't found the actual trick you used, but it works great. Now, I will apply YOUR changes to the "printer" module and when I apply them, I may see where I went wrong. Again, Thank You. About 3 years after I first wrote/translated it, an officer from the Los Angeles Police Department download it to do some studies of accidents at certain intersections and, he telephone me and told me that it was scary how accurate it appeared to be. I tried to find someone to translate it to Visual Basic so I could have some of the "fancy" windows graphics but couldn't find anyone (they didn't like my code structure). As I was writing it, I would get more ideas of what to add and used a lot of "gosub" routines.

In a couple of weeks after my back heals from sitting here, I will put the complete software with the overlays, modules, etc. on http://www.oiccs.com/biorhyth.zip if you would like a copy. It will include the source code, i.e. *.bas files. The web page also contains my email address. If I can ever help you with anything, please don't hesitate to ask.
Thanks again,
George

Title: Re: Coding Conversion Problem
Post by: bplus on June 03, 2020, 07:37:38 pm

Sounds like it worked. :)

I just changed the functions like Cobalt did, only I SHARED V and P# so they could be read from the FUNCTION code without adding more parameters, so the FNx's kept the original single or 0 parameters. So all that happened was the FNx's part was commented out the first 2 lines to SHARED variables for FUNCTIONs and last lines to replace FNx's.

Gold Star to QB64 remaining compatible.

Text Only | Text with Attachments

QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: GeorgeLee on June 01, 2020, 05:18:58 pm