mirror of
https://github.com/QB64-Phoenix-Edition/QB64pe.git
synced 2024-09-20 05:34:47 +00:00
9ee89d6ff4
These tests use a variety of sample code (with some of the larger files removed, so they are not complete!) and verifies that they all compile successfully.
324 lines
6.7 KiB
QBasic
324 lines
6.7 KiB
QBasic
CHDIR ".\programs\samples\thebob\biochart"
|
|
|
|
'****************************************************************************'
|
|
'------------------------- B I O C H A R T . B A S --------------------------'
|
|
'------------- Copyright (C) 2007 by Bob Seguin (Freeware)-------------------'
|
|
'****************************************************************************'
|
|
|
|
DEFINT A-Z
|
|
DECLARE SUB PrintSTRING (x, y, Prnt$)
|
|
DECLARE SUB Graphics ()
|
|
DECLARE SUB ChartGFX ()
|
|
DECLARE SUB Birthday ()
|
|
DECLARE SUB ChartBD ()
|
|
DECLARE SUB PutNUMS (x, Num)
|
|
|
|
DECLARE FUNCTION GetDATE$ ()
|
|
|
|
DIM SHARED NumBOX(300)
|
|
DIM SHARED Box(12000)
|
|
DIM SHARED FontBOX(6000)
|
|
DIM SHARED xBOX(1 TO 9)
|
|
DEF SEG = VARSEG(FontBOX(0))
|
|
BLOAD "brsmssb.fnt", VARPTR(FontBOX(0))
|
|
DEF SEG = VARSEG(NumBOX(0))
|
|
BLOAD "brsnums.bsv", VARPTR(NumBOX(0))
|
|
DEF SEG
|
|
|
|
CONST Degree! = 3.14159 / 180
|
|
CONST Physical! = 90 / 23
|
|
CONST Emotional! = 90 / 28
|
|
CONST Intellectual! = 90 / 33
|
|
CONST Intuitive! = 90 / 38
|
|
|
|
DIM SHARED DATE2$, Birthdate$
|
|
DIM SHARED Hour!
|
|
DIM SHARED Months(1 TO 12) AS INTEGER
|
|
RESTORE MonthDATA
|
|
FOR n = 1 TO 12: READ Months(n): NEXT n
|
|
RESTORE xDATA
|
|
FOR n = 1 TO 8: READ xBOX(n): NEXT n
|
|
|
|
SCREEN 12
|
|
GOSUB SetPALETTE
|
|
DATE2$ = DATE$
|
|
|
|
Graphics
|
|
Birthday
|
|
|
|
DO
|
|
k$ = UCASE$(INKEY$)
|
|
SELECT CASE k$
|
|
CASE "B"
|
|
PUT (162, 176), Box, PSET
|
|
B$ = GetDATE$
|
|
IF B$ = "NULL" THEN
|
|
SYSTEM
|
|
ELSE
|
|
Birthdate$ = B$
|
|
ChartBD
|
|
END IF
|
|
CASE "T"
|
|
PUT (162, 181), Box(3500), PSET
|
|
B$ = GetDATE$
|
|
IF B$ = "NULL" THEN DATE2$ = DATE$ ELSE DATE2$ = B$
|
|
LINE (194, 419)-(294, 434), 0, BF
|
|
PrintSTRING 196, 420, "DATE: " + DATE2$
|
|
ChartBD
|
|
CASE CHR$(27): EXIT DO
|
|
END SELECT
|
|
LOOP
|
|
|
|
SYSTEM
|
|
|
|
xDATA:
|
|
DATA 379, 386, 402, 409, 425, 432, 439, 446
|
|
|
|
MonthDATA:
|
|
DATA 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31
|
|
|
|
SetPALETTE:
|
|
RESTORE SetPALETTE
|
|
DATA 0, 0, 21, 21, 8, 43, 24, 10, 48, 26, 11, 53
|
|
DATA 28,12,58, 32, 13, 63, 63, 63, 21, 42, 42, 42
|
|
DATA 63, 0, 0, 21, 31, 63, 52, 41, 63, 55, 55, 55
|
|
DATA 0, 0, 42, 63, 21, 63, 32, 32, 42, 63, 63, 63
|
|
RESTORE SetPALETTE
|
|
OUT &H3C8, 0
|
|
FOR n = 1 TO 48
|
|
READ Colr
|
|
OUT &H3C9, Colr
|
|
NEXT n
|
|
RETURN
|
|
|
|
SUB Birthday
|
|
|
|
OPEN "brbd.dta" FOR BINARY AS #1
|
|
IF LOF(1) THEN
|
|
CLOSE #1
|
|
OPEN "brbd.dta" FOR INPUT AS #1
|
|
INPUT #1, Birthdate$
|
|
CLOSE #1
|
|
ELSE
|
|
CLOSE #1
|
|
PUT (162, 176), Box, PSET
|
|
B$ = GetDATE$
|
|
IF B$ = "NULL" THEN
|
|
SYSTEM
|
|
ELSE
|
|
Birthdate$ = B$
|
|
END IF
|
|
END IF
|
|
ChartBD
|
|
|
|
END SUB
|
|
|
|
SUB ChartBD
|
|
|
|
LINE (220, 89)-(420, 102), 0, BF
|
|
PrintSTRING 240, 89, "For a person born"
|
|
PrintSTRING 340, 89, Birthdate$
|
|
OPEN "brbd.dta" FOR OUTPUT AS #1
|
|
PRINT #1, Birthdate$
|
|
CLOSE #1
|
|
ChartGFX
|
|
|
|
Hour! = VAL(MID$(TIME$, 1, 2)) * .83
|
|
LINE (310 + Hour!, 110)-(310 + Hour!, 426), 11
|
|
LINE (310 + Hour!, 426)-(338, 426), 11
|
|
PSET (310, 410), 7: DRAW "D16L12"
|
|
|
|
Month$ = MID$(DATE2$, 1, 2)
|
|
Day$ = MID$(DATE2$, 4, 2)
|
|
Year$ = MID$(DATE2$, 7, 4)
|
|
M$ = MID$(Birthdate$, 1, 2)
|
|
D$ = MID$(Birthdate$, 4, 2)
|
|
y$ = MID$(Birthdate$, 7, 4)
|
|
FirstMONTH = Months(VAL(M$)) - VAL(D$) + 1
|
|
FOR n = (VAL(M$) + 1) TO 12
|
|
BalMONTHS = BalMONTHS + Months(n)
|
|
IF n = 2 AND ((VAL(y$) MOD 4) = 0) THEN BalMONTHS = BalMONTHS + 1
|
|
NEXT n
|
|
FirstYEAR = FirstMONTH + BalMONTHS
|
|
FOR n = (VAL(y$) + 1) TO (VAL(Year$) - 1)
|
|
IF n MOD 4 = 0 THEN Yr = 366 ELSE Yr = 365
|
|
TDays = TDays + Yr
|
|
NEXT n
|
|
TDays = TDays + FirstYEAR
|
|
|
|
FOR n = 1 TO VAL(Month$) - 1
|
|
Days = Days + Months(n)
|
|
IF n = 2 THEN
|
|
IF VAL(Year$) MOD 4 = 0 THEN Days = Days + 1
|
|
END IF
|
|
NEXT n
|
|
|
|
TDays = TDays + Days + VAL(Day$) - 1
|
|
|
|
VIEW SCREEN (10, 110)-(630, 410)
|
|
|
|
'EMOTIONAL
|
|
PreviousX = 320 - (((TDays MOD 28) + 28) * 20)
|
|
PreviousY = 260
|
|
C! = 0
|
|
FOR x = 320 - (((TDays MOD 28) + 28) * 20) TO 630 STEP 5
|
|
LINE (PreviousX, PreviousY)-(x, 260 + SIN(C! * Degree!) * 150), 8
|
|
PreviousX = x
|
|
PreviousY = 260 + SIN(C! * Degree!) * 150
|
|
C! = C! - Emotional!
|
|
NEXT x
|
|
|
|
'INTELLECTUAL
|
|
PreviousX = 320 - (((TDays MOD 33) + 33) * 20)
|
|
PreviousY = 260
|
|
C! = 0
|
|
FOR x = 320 - (((TDays MOD 33) + 33) * 20) TO 630 STEP 5
|
|
LINE (PreviousX, PreviousY)-(x, 260 + SIN(C! * Degree!) * 150), 6
|
|
PreviousX = x
|
|
PreviousY = 260 + SIN(C! * Degree!) * 150
|
|
C! = C! - Intellectual!
|
|
NEXT x
|
|
|
|
PreviousX = 10
|
|
PreviousY = 260
|
|
C! = 0
|
|
'PHYSICAL
|
|
PreviousX = 320 - (((TDays MOD 23) + 23) * 20)
|
|
PreviousY = 250
|
|
FOR x = 320 - (((TDays MOD 23) + 23) * 20) TO 630 STEP 5
|
|
LINE (PreviousX, PreviousY)-(x, 260 + SIN(C! * Degree!) * 150), 9
|
|
PreviousX = x
|
|
PreviousY = 260 + SIN(C! * Degree!) * 150
|
|
C! = C! - Physical!
|
|
NEXT x
|
|
|
|
|
|
'INTUITIVE
|
|
PreviousX = 320 - (((TDays MOD 38) + 38) * 20)
|
|
PreviousY = 260
|
|
C! = 0
|
|
FOR x = 320 - (((TDays MOD 38) + 38) * 20) TO 630 STEP 5
|
|
LINE (PreviousX, PreviousY)-(x, 260 + SIN(C! * Degree!) * 150), 13
|
|
PreviousX = x
|
|
PreviousY = 260 + SIN(C! * Degree!) * 150
|
|
C! = C! - Intuitive!
|
|
NEXT x
|
|
|
|
VIEW
|
|
|
|
END SUB
|
|
|
|
DEFSNG A-Z
|
|
SUB ChartGFX
|
|
|
|
LINE (5, 106)-(634, 414), 7, BF
|
|
LINE (9, 109)-(631, 170), 1, BF
|
|
LINE (9, 170)-(631, 230), 2, BF
|
|
LINE (9, 230)-(631, 290), 3, BF
|
|
LINE (9, 290)-(631, 350), 2, BF
|
|
LINE (9, 350)-(631, 411), 1, BF
|
|
LINE (9, 109)-(631, 411), 7, B
|
|
FOR x = 30 TO 610 STEP 20
|
|
LINE (x, 110)-(x, 410), 7
|
|
IF x = 330 THEN PAINT (x - 10, 260), 7
|
|
NEXT x
|
|
LINE (10, 260)-(630, 260), 7
|
|
|
|
END SUB
|
|
|
|
DEFINT A-Z
|
|
FUNCTION GetDATE$
|
|
i = 1: Interval! = .25: Colr = 15
|
|
DO
|
|
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
|
|
IF i < 9 THEN LINE (xBOX(i) + 1, 201)-(xBOX(i) + 6, 202), Colr, B
|
|
k$ = INKEY$
|
|
SELECT CASE k$
|
|
CASE "0" TO "9"
|
|
IF i < 9 THEN
|
|
LINE (xBOX(i) + 1, 201)-(xBOX(i) + 6, 202), 15, BF
|
|
PutNUMS xBOX(i), VAL(k$)
|
|
D$ = D$ + k$
|
|
i = i + 1
|
|
END IF
|
|
CASE CHR$(13) 'Enter
|
|
IF LEN(D$) = 8 THEN
|
|
mm$ = MID$(D$, 1, 2)
|
|
dd$ = MID$(D$, 3, 2)
|
|
yy$ = MID$(D$, 5, 4)
|
|
IF VAL(mm$) > 0 AND VAL(mm$) < 13 THEN
|
|
IF VAL(dd$) > 0 AND VAL(dd$) < 32 THEN
|
|
IF VAL(yy$) > 1900 AND VAL(yy$) < 3000 THEN
|
|
GetDATE$ = mm$ + "-" + dd$ + "-" + yy$
|
|
ELSE
|
|
GetDATE$ = "NULL"
|
|
END IF
|
|
ELSE
|
|
GetDATE$ = "NULL"
|
|
END IF
|
|
ELSE
|
|
GetDATE$ = "NULL"
|
|
END IF
|
|
ELSE
|
|
GetDATE$ = "NULL"
|
|
END IF
|
|
EXIT FUNCTION
|
|
CASE CHR$(8) 'Backspace
|
|
IF i > 1 THEN
|
|
IF i < 9 THEN LINE (xBOX(i), 193)-(xBOX(i) + 6, 202), 15, BF
|
|
i = i - 1
|
|
LINE (xBOX(i), 193)-(xBOX(i) + 6, 202), 15, BF
|
|
D$ = MID$(D$, 1, LEN(D$) - 1)
|
|
END IF
|
|
END SELECT
|
|
|
|
IF TIMER > StartTIME! + Interval! THEN
|
|
StartTIME! = TIMER
|
|
IF Colr = 15 THEN Colr = 7 ELSE Colr = 15
|
|
END IF
|
|
|
|
LOOP
|
|
|
|
END FUNCTION
|
|
|
|
SUB Graphics
|
|
DEF SEG = VARSEG(Box(0))
|
|
BLOAD "brsheads.bsv", VARPTR(Box(0))
|
|
DEF SEG
|
|
PUT (78, 32), Box
|
|
PUT (20, 440), Box(7000)
|
|
PUT (10, 6), Box(10000)
|
|
PUT (500, 6), Box(11200)
|
|
|
|
PrintSTRING 196, 420, "DATE: " + DATE2$
|
|
PrintSTRING 342, 420, "TIME: " + TIME$
|
|
PrintSTRING 12, 460, "Press [B] to enter a new birth date"
|
|
PrintSTRING 270, 460, "Press [T] to enter a target date"
|
|
PrintSTRING 520, 460, "Press [ESC] to QUIT"
|
|
|
|
ChartGFX
|
|
|
|
DEF SEG = VARSEG(Box(0))
|
|
BLOAD "brsinpt.bsv", VARPTR(Box(0))
|
|
DEF SEG
|
|
|
|
END SUB
|
|
|
|
SUB PrintSTRING (x, y, Prnt$)
|
|
|
|
FOR i = 1 TO LEN(Prnt$)
|
|
Char$ = MID$(Prnt$, i, 1)
|
|
IF Char$ = " " THEN
|
|
x = x + FontBOX(1)
|
|
ELSE
|
|
Index = (ASC(Char$) - 33) * FontBOX(0) + 2
|
|
PUT (x, y), FontBOX(Index)
|
|
x = x + FontBOX(Index)
|
|
END IF
|
|
NEXT i
|
|
|
|
END SUB
|
|
|
|
SUB PutNUMS (x, Num)
|
|
PUT (x, 191), NumBOX(Num * 30)
|
|
END SUB
|