Code for the H-R Diagram program follows:
DECLARE SUB GetKey (X%)
'----------------------------------------------------------------------
' H-R charts an H-R diagram for 157 stars with known Mv and B-V.
'----------------------------------------------------------------------
CONST NumPts = 157 ' Number of points.
CONST True = -1
CONST False = 0
CONST Blue = 11
CONST LightBlue = 9
CONST White = 15
CONST Yellow = 14
CONST Red = 12
DIM StarName(1 TO NumPts) AS STRING * 17
DIM Cp(1 TO NumPts) AS STRING * 1
DIM Sp(1 TO NumPts) AS STRING * 6
DIM Lum(1 TO NumPts) AS STRING * 6
DIM Mv(1 TO NumPts) AS SINGLE
DIM B.V(1 TO NumPts) AS SINGLE
'======================================================================
' Determine ranges of each value:
MaxM = 0
MinM = 0
MaxB = 0
MinB = 0
FOR I% = 1 TO NumPts
READ StarName(I%), Cp(I%), Sp(I%), Lum(I%), Y$, X$
Mv(I%) = VAL(Y$)
B.V(I%) = VAL(X$)
IF Mv(I%) > MaxM THEN MaxM = Mv(I%)
IF Mv(I%) < MinM THEN MinM = Mv(I%)
IF B.V(I%) > MaxB THEN MaxB = B.V(I%)
IF B.V(I%) < MinB THEN MinB = B.V(I%)
NEXT I%
' Find transformation constants to plot the chart neatly on-screen:
' Note: In VGA mode 12, X covers 640 pixels and Y covers 480. To
' provide some margin (10 + whatever), we'll use 600 and 450 (each
' figure is exactly 93.75% of the VGA ranges).
DeltaM = 100 * (MaxM - MinM)
DeltaB = 100 * (MaxB - MinB)
Mlow = 100 * ABS(MinM)
Blow = 100 * ABS(MinB)
Mfactor = 450 / (100 * MaxM + Mlow)
Bfactor = 600 / (100 * MaxB + Blow)
'CLS
'PRINT "Mv and B-V range, width, low intercept, factor:"
'PRINT MinM, MaxM, DeltaM, Mlow, Mfactor
'PRINT MinB, MaxB, DeltaB, Blow, Bfactor
' Plot the points, using appropriate colors:
SCREEN 12
WhiteOnly = False
FOR I% = 1 TO NumPts
Y = Mfactor * (100 * Mv(I%) + Mlow) + 10
X = Bfactor * (100 * B.V(I%) + Blow) + 10
IF WhiteOnly THEN
StarColor = White
ELSE
Class$ = LEFT$(Sp(I%), 1)
SELECT CASE Class$
CASE "O": StarColor = Blue
CASE "B": StarColor = LightBlue
CASE "A": StarColor = White
CASE "F": StarColor = Yellow
CASE "G": StarColor = Yellow
CASE "K": StarColor = Red
CASE "M": StarColor = Red
CASE "C": StarColor = Red
END SELECT
END IF
PSET (X, Y), StarColor
NEXT I%
CALL GetKey(X%)
' Clean up and quit:
SCREEN 0
COLOR 7, 0, 0
LOCATE 24, 1
SYSTEM
'---------------------------------------------------------------------
DATA "Sirius ", "A", "A1 ", "V ", " 1.42", " 0.00"
DATA "Sirius ", "B", "A5 ", "VII ", " 11.20", " -0.12"
DATA "Canopus ", "A", "F0 ", "Ia ", " -8.50", " 0.15"
DATA "Arcturus ", "A", "K2 p ", "III ", " -0.20", " 1.23"
DATA "Alp Cen ", "A", "G2 ", "V ", " 4.37", " 0.68"
DATA "Alp Cen ", "B", "K0 ", "V ", " 5.71", " 0.88"
DATA "Alp Cen ", "C", "M5 ", "V ", " 15.49", " 1.97"
DATA "Vega ", "A", "A0 ", "V ", " 0.50", " 0.00"
DATA "Capella ", "A", "G8 ", "III ", " -0.50", " 0.80"
DATA "Rigel ", "A", "B8 ", "Ia ", " -7.10", " -0.03"
DATA "Procyon ", "A", "F5 ", "IV-V ", " 2.64", " 0.42"
DATA "Betelgeuse ", "A", "M2 ", "Iab ", " -6.00", " 1.85"
DATA "Achernar ", "A", "B5 ", "IV ", " -1.60", " -0.16"
DATA "Hadar ", "A", "B1 ", "II ", " -5.10", " -0.24"
DATA "Altair ", "A", "A7 ", "IV-V ", " 2.24", " 0.22"
DATA "Aldebaran ", "A", "K5 ", "III ", " -0.80", " 1.54"
DATA "Acrux ", "A", "B1 ", "IV ", " -3.80", " 0.10"
DATA "Spica ", "A", "B1 ", "V ", " -3.50", " -0.23"
DATA "Antares ", "A", "M1 ", "Ib ", " -4.00", " 1.83"
DATA "Fomalhaut ", "A", "A3 ", "V ", " 2.00", " 0.09"
DATA "Pollux ", "A", "K0 ", "III ", " 0.90", " 1.00"
DATA "Deneb ", "A", "A2 ", "Ia ", " -7.50", " 0.09"
DATA "Mimosa ", "A", "B0 ", "III ", " -4.30", " -0.23"
DATA "Sol ", "A", "G2 ", "V ", " 4.85", " 0.65"
DATA "Barnard's Star ", "A", "M5 ", "V ", " 13.22", " 1.74"
DATA "Wolf 359 ", "A", "M6 ", "V ", " 16.65", " 2.01"
DATA "Lalande 21185 ", "A", "M2 ", "V ", " 10.50", " 1.51"
DATA "Luyten 726-8 ", "A", "M5 ", "V ", " 15.46", " 1.85"
DATA "Luyten 726-8 ", "B", "M6 ", "V ", " 15.96", " 1.85"
DATA "Ross 154 ", "A", "M5 ", "V ", " 13.14", " 1.70"
DATA "Ross 248 ", "A", "M6 ", "V ", " 14.78", " 1.91"
DATA "18 Eps Eri ", "A", "K2 ", "V ", " 6.14", " 0.88"
DATA "Luyten 789-6 ", "A", "M7 ", "V ", " 14.49", " 1.96"
DATA "Ross 128 ", "A", "M5 ", "V ", " 13.47", " 1.76"
DATA "61 Cyg ", "A", "K5 ", "V ", " 7.56", " 1.17"
DATA "61 Cyg ", "B", "K7 ", "V ", " 8.37", " 1.37"
DATA "Eps Ind ", "A", "K5 ", "V ", " 7.00", " 1.05"
DATA "Struve 2398 ", "A", "M4 ", "V ", " 11.15", " 1.54"
DATA "Struve 2398 ", "B", "M5 ", "V ", " 11.94", " 1.59"
DATA "Groombridge 34 ", "A", "M1 ", "V ", " 10.39", " 1.56"
DATA "Groombridge 34 ", "B", "M6 ", "V ", " 13.37", " 1.80"
DATA "Lacaille 9352 ", "A", "M2 ", "V ", " 9.58", " 1.48"
DATA "52 Tau Cet ", "A", "G8 ", "V ", " 5.72", " 0.72"
DATA "BD +05 1668 ", "A", "M5 ", "V ", " 11.94", " 1.56"
DATA "L 725-32 ", "A", "M5 ", "V ", " 14.12", " 1.83"
DATA "Lacaille 8760 ", "A", "M0 ", "V ", " 8.74", " 1.40"
DATA "Kapteyn's Star ", "A", "M0 ", "V ", " 10.88", " 1.56"
DATA "Kruger 60 ", "A", "M3 ", "V ", " 11.87", " 1.62"
DATA "Kruger 60 ", "B", "M4 ", "V ", " 13.30", " 1.80"
DATA "G 51-15 ", "A", "M? ", "V ", " 17.03", " 2.06"
DATA "Van Maanen's Star", "A", "F5 ", "VII ", " 14.20", " 0.56"
DATA "BD +50 1725 ", "A", "K7 ", "V ", " 8.32", " 1.36"
DATA "40 Omi-2 Eri ", "A", "K0 ", "V ", " 6.01", " 0.82"
DATA "40 Omi-2 Eri ", "B", "A3 ", "VII ", " 11.10", " 0.03"
DATA "40 Omi-2 Eri ", "C", "M? ", "V ", " 12.75", " 1.66"
DATA "Gliese 876 ", "A", "M4 ", "V ", " 11.77", " 1.60"
DATA "Alpheratz ", "A", "A0 p ", " ", " 0.30", " -0.11"
DATA "Caph ", "A", "F2 ", "IV ", " 1.70", " 0.34"
DATA "Ankaa ", "A", "K0 ", "III ", " 0.50", " 1.09"
DATA "Schedar ", "A", "K0 ", "II-III", " -0.60", " 1.17"
DATA "Diphda ", "A", "K0 ", "III ", " 0.40", " 1.02"
DATA "Cih ", "A", "B0 ", "IVe ", " -4.40", " -0.15"
DATA "Mirach ", "A", "M0 ", "III ", " -0.10", " 1.58"
DATA "Almach ", "A", "K2 ", "III ", " -0.70", " 1.20"
DATA "Hamal ", "A", "K2 ", "III ", " -0.10", " 1.15"
DATA "Mira ", "A", "Md ", " ", " -0.30", " 1.70"
DATA "Polaris ", "A", "F8 ", "Ib ", " -4.60", " 0.60"
DATA "Menkar ", "A", "M2 ", "III ", " -0.50", " 1.64"
DATA "Algol ", "A", "B8 ", "V ", " -0.20", " -0.05"
DATA "Mirfak ", "A", "F5 ", "Ib ", " -4.60", " 0.48"
DATA "Bellatrix ", "A", "B2 ", "III ", " -3.60", " -0.22"
DATA "El Nath ", "A", "B7 ", "III ", " -1.40", " -0.13"
DATA "Arneb ", "A", "F0 ", "Ib ", " -4.70", " 0.21"
DATA "Alnilam ", "A", "B0 ", "Ia ", " -6.10", " -0.19"
DATA "Alnitak ", "A", "O9.5 ", "Ib ", " -5.90", " -0.21"
DATA "Saiph ", "A", "B0.5 ", "Ia ", " -6.70", " -0.17"
DATA "Menkalinan ", "A", "A2 ", "IV ", " 0.20", " 0.03"
DATA "Mirzam ", "A", "B1 ", "II-III", " -4.70", " -0.23"
DATA "Alhena ", "A", "A0 ", "IV ", " -0.10", " 0.00"
DATA "Adhara ", "A", "B2 ", "II ", " -4.40", " -0.21"
DATA "Wezen ", "A", "F8 ", "Ia ", " -8.00", " 0.65"
DATA "Aludra ", "A", "B5 ", "Ia ", " -7.00", " -0.07"
DATA "Castor ", "A", "A1 ", "V ", " 0.80", " 0.04"
DATA "Avior ", "A", "K0 ", "II ", " -2.10", " 1.27"
DATA "Del Vel ", "A", "A0 ", "V ", " 0.30", " 0.04"
DATA "Suhail ", "A", "K5 ", "Ib ", " -3.70", " 1.66"
DATA "Miaplacidus ", "A", "A0 ", "III ", " -0.40", " 0.00"
DATA "Aspidiske ", "A", "F0 ", "Ib ", " -4.70", " 0.18"
DATA "Kap Vel ", "A", "B2 ", "IV ", " -2.90", " -0.18"
DATA "Alphard ", "A", "K3 ", "III ", " -0.10", " 1.44"
DATA "Regulus ", "A", "B7 ", "V ", " -0.70", " -0.11"
DATA "Algieba ", "A", "K0 ", "III ", " 0.20", " 1.08"
DATA "Merak ", "A", "A1 ", "V ", " 1.00", " -0.02"
DATA "Dubhe ", "A", "K0 ", "III ", " 0.00", " 1.07"
DATA "Zosma ", "A", "A4 ", "V ", " 1.50", " 0.12"
DATA "Denebola ", "A", "A3 ", "V ", " 1.70", " 0.09"
DATA "Phecda ", "A", "A0 ", "V ", " 0.60", " 0.00"
DATA "Gienah ", "A", "B8 ", "III ", " -1.20", " -0.11"
DATA "Gacrux ", "A", "M3 ", "III ", " -0.50", " 1.59"
DATA "Muhlifain ", "A", "A0 ", "III ", " -0.50", " -0.01"
DATA "Alioth ", "A", "A0 p ", " ", " 0.40", " -0.02"
DATA "Mizar ", "A", "A2 ", "V ", " 1.00", " 0.02"
DATA "Eps Cen ", "A", "B1 ", "V ", " -3.60", " -0.22"
DATA "Alkaid ", "A", "B3 ", "V ", " -0.70", " -0.19"
DATA "Zet Cen ", "A", "B2 ", "IV ", " -2.70", " -0.22"
DATA "Menkent ", "A", "K0 ", "III-IV", " 1.30", " 1.01"
DATA "Eta Cen ", "A", "B3 ", "III ", " -2.90", " -0.19"
DATA "Alp Lup ", "A", "B1 ", "III ", " -4.30", " -0.20"
DATA "Izar ", "A", "K0 ", "II-III", " -0.90", " 0.97"
DATA "Kochab ", "A", "K4 ", "III ", " -0.20", " 1.47"
DATA "Alphecca ", "A", "A0 ", "V ", " 0.30", " -0.02"
DATA "Dzuba ", "A", "B0 ", "V ", " -3.80", " -0.12"
DATA "Acrab ", "A", "B0.5 ", "V ", " -4.30", " -0.07"
DATA "Acrab ", "B", "B2 ", "V ", " -2.50", " -0.02"
DATA "13 Zet Oph ", "A", "O9.5 ", "V ", " -3.60", " 0.02"
DATA "Atria ", "A", "K2 ", "III ", " 0.80", " 1.44"
DATA "26 Eps Sco ", "A", "K2 ", "III ", " 0.80", " 1.15"
DATA "Sabik ", "A", "A2 ", "V ", " 1.20", " 0.06"
DATA "Shaula ", "A", "B2 ", "IV ", " -3.00", " -0.22"
DATA "Ras-Alhague ", "A", "A5 ", "III ", " 0.70", " 0.15"
DATA "The Sco ", "A", "F0 ", "I-II ", " -5.40", " 0.40"
DATA "Kap Sco ", "A", "B2 ", "IV ", " -3.00", " -0.22"
DATA "Eltanin ", "A", "K5 ", "III ", " -0.20", " 1.52"
DATA "Kaus Australis ", "A", "B9 ", "IV ", " -0.20", " -0.03"
DATA "Nunki ", "A", "B3 ", "IV-V ", " -2.00", " -0.22"
DATA "Sadir ", "A", "F8 ", "Ib ", " -4.60", " 0.68"
DATA "Peacock ", "A", "B3 ", "IV ", " -2.30", " -0.20"
DATA "Gienar ", "A", "K0 ", "III ", " 0.50", " 1.03"
DATA "Alderamin ", "A", "A7 ", "IV-V ", " 1.70", " 0.22"
DATA "Enif ", "A", "K2 ", "Ib ", " -3.60", " 1.52"
DATA "Al Nair ", "A", "B5 ", "V ", " 0.10", " -0.13"
DATA "Bet Gru ", "A", "M3 ", "II ", " -1.50", " 1.62"
DATA "Scheat ", "A", "M2 ", "II-III", " -1.20", " 1.67"
DATA "Markab ", "A", "B9 ", "V ", " 0.00", " -0.04"
DATA "BD -12 4523 ", "A", "M5 ", "V ", " 12.07", " 1.60"
DATA "Ross 614 ", "A", "M7 e ", "V ", " 13.12", " 1.71"
DATA "Ross 614 ", "B", "M? ", "V ", " 16.00", " 1.71"
DATA "Wolf 424 ", "A", "M6 e ", "V ", " 14.97", " 1.80"
DATA "Wolf 424 ", "B", "M6 e ", "V ", " 15.20", " 1.80"
DATA "CD -37 15492 ", "A", "M4 ", "V ", " 10.32", " 1.46"
DATA "L 1159-16 ", "A", "M8 e ", "V ", " 14.01", " 1.82"
DATA "CD -46 11540 ", "A", "M4 ", "V ", " 11.04", " 1.53"
DATA "G 158-27 ", "A", "M ", "V ", " 15.39", " 1.95"
DATA "CD -49 13515 ", "A", "M1 ", "V ", " 10.32", " 1.46"
DATA "CD -44 11909 ", "A", "M5 ", "V ", " 12.60", " 1.65"
DATA "BD +68 946 ", "A", "M3.5 ", "V ", " 10.79", " 1.50"
DATA "G 208-44/45 ", "A", "M? ", "V? ", " 15.03", " 1.90"
DATA "G 208-44/45 ", "B", "M? ", "V? ", " 15.61", " 1.98"
DATA "BD +20 2465 ", "A", "M4.5 e", "V ", " 11.00", " 1.54"
DATA "L 145-141 ", "A", "C ", "VII ", " 13.07", " 0.19"
DATA "70 Oph ", "A", "K0 ", "V ", " 5.76", " 0.86"
DATA "70 Oph ", "B", "K5 ", "V ", " 7.54", " 0.86"
DATA "BD +43 4305 ", "A", "M5 e ", "V ", " 11.70", " 1.60"
DATA "AC +79 3888 ", "A", "M4 ", "VI ", " 12.23", " 1.60"
DATA "G 9-38 ", "A", "M ", "V ", " 15.48", " 1.84"
DATA "G 9-38 ", "B", "M ", "V ", " 16.34", " 1.93"
DATA "BD +15 2620 ", "A", "M4 ", "V ", " 9.91", " 1.44"
'----------------------------------------------------------------------
' GetKey reads a single keypress and returns a one-byte key ID code.
'----------------------------------------------------------------------
SUB GetKey (X%)
DO
Key1$ = INKEY$
L% = LEN(Key1$)
LOOP UNTIL L% <> 0
IF L% = 1 THEN
X% = ASC(Key1$)
ELSE
X% = 1000 + ASC(RIGHT$(Key1$, 1))
END IF
END SUB ' GetKey