' STARS.BAS - (C) 2021 Pegasus Epsilon <pegasus@pimpninjas.org>
' Educational Purposes Only
'
' @bluesaxman#7285 on my discord was talking about how he wrote QB all the
' time back in the day. The next day I was really itching to write some QB.
' So I did.
'
' DOSBOX NOTE:
' I wrote all my QB back in the day on a 66MHz 486. To match those specs with
' dosbox, you need to change the "cycles" line in your dosbox.conf to match:
'
' cycles=fixed 26800
'
' Source: https://www.dosbox.com/wiki/Performance#Emulated_CPU_equivalency
'
' My testing shows this program running just fine all the way down to
' cycles=fixed 9000, which speedtst registers as somewhere between a 386SX
' 40MHz and a 386DX 40MHz.
'
' Compile without debug information and run the executable for proper speed.
DECLARE SUB drawLetter (ox%, oy%)
DECLARE FUNCTION onScreen% (x%, y%)
DECLARE FUNCTION ProjectX% (x%, z%)
DECLARE FUNCTION ProjectY% (y%, z%)
fontH:
DATA 1, 12, 22, , 1, 12, 22
DATA 4, 64, 25, , 4, 64, 25
DATA 7, 73, 28, , 7, 73, 28
DATA 10, 82, 31, 1, 10, 82, 31
DATA 13, 91, 33, , 13, 91, 33
DATA 16,100, 36, , 16,100, 36
DATA 19,119, 39, , 19,119, 39
DATA 22, 32, 42, , 22, 32, 42
fontE:
DATA 1, 12, 22, 1, 1, 12, 22
DATA 4, 64, 25, , 22, 32, 42
DATA 7, 75, 28, , , ,
DATA 10, 86, 31, 1, , ,
DATA 13, 97, 33, , , ,
DATA 16,108, 36, , 1, 12, 22
DATA 19,119, 39, , 12,119, 32
DATA 22, 32, 42, 1, 22, 32, 42
fontL:
DATA 1, 12, 22, , , ,
DATA 4, 64, 25, , , ,
DATA 7, 75, 28, , , ,
DATA 10, 86, 31, , , ,
DATA 13, 97, 33, , , ,
DATA 16,108, 36, , 1, 12, 22
DATA 19,119, 39, , 12,119, 32
DATA 22, 32, 42, 1, 22, 32, 42
fontO:
DATA , 12, 22, 1, 1, 12,
DATA 4, 64, 25, , 4, 64, 25
DATA 7, 73, 28, , 7, 73, 28
DATA 10, 82, 31, , 10, 82, 31
DATA 13, 91, 33, , 13, 91, 33
DATA 16,100, 36, , 16,100, 36
DATA 19,119, 39, , 19,119, 39
DATA , 32, 42, 1, 22, 32,
fontB:
DATA 1, 12, 22, 1, 1, 12,
DATA 4, 64, 25, , 4, 64, 28
DATA 7, 73, 28, , 7, 33,
DATA 10, 82, 31, 1, 10, ,
DATA 13, 91, 33, , 13, 16,
DATA 16,100, 36, , 16,100, 22
DATA 19,119, 39, , 19,119, 32
DATA 22, 32, 42, 1, 22, 32,
fontU:
DATA 1, 12, 22, , 1, 12, 22
DATA 4, 64, 25, , 4, 64, 25
DATA 7, 73, 28, , 7, 73, 28
DATA 10, 82, 31, , 10, 82, 31
DATA 13, 91, 33, , 13, 91, 33
DATA 16,100, 36, , 16,100, 36
DATA 19,119, 39, , 19,119, 39
DATA , 32, 42, 1, 22, 32,
CONST speed% = 6
CONST starcount% = 200
RANDOMIZE TIMER ' seed the PRNG
SCREEN 13 ' BIOS mode 13h, 320x200x256 colors (out of 262,144)
' black out palette so we can draw in secret
OUT &H3C8, 0
FOR i% = 0 TO 255
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 0
NEXT i%
msg$ = "hello blue"
RESTORE fontH
drawLetter 8, 0
RESTORE fontE
drawLetter 16, 0
RESTORE fontL
drawLetter 24, 0
RESTORE fontL
drawLetter 32, 0
RESTORE fontO
drawLetter 40, 0
RESTORE fontB
drawLetter 56, 0
RESTORE fontL
drawLetter 64, 0
RESTORE fontU
drawLetter 72, 0
RESTORE fontE
drawLetter 80, 0
DIM hello((8 * 8 * LEN(msg$) + 8) \ 4) AS LONG ' 32 bits, 4 bytes
GET (7, 0)-(8 * LEN(msg$) + 7, 7), hello
CLS
' initialize palette
OUT &H3C8, 1
FOR c% = 63 TO 1 STEP -1 ' 63 shades of grey (64 counting 0 = black)
OUT &H3C9, c%
OUT &H3C9, c%
OUT &H3C9, c%
NEXT c%
FOR c% = 0 TO 63 ' 64 shades of blue
blu% = 63 - c%
OUT &H3C9, blu% / 4
OUT &H3C9, blu% / 2
OUT &H3C9, blu%
NEXT c%
top% = 21
bottom% = 178
left% = 0
right% = 319
tall% = bottom% - top% + 1
halftall% = tall% \ 2
wide% = right% - left% + 1
halfwide% = wide% \ 2
DIM starX(starcount%) AS INTEGER
DIM starY(starcount%) AS INTEGER
DIM starZ(starcount%) AS INTEGER
FOR star% = 1 TO starcount%
DO
starX(star%) = INT(RND * wide%) + left%
starY(star%) = INT(RND * tall%) + top%
starZ(star%) = INT(RND * 255) + 1
' better data passing methods than QB provides would
' eliminate the need for these variables...
px% = ProjectX(starX(star%), starZ(star%))
py% = ProjectY(starY(star%), starZ(star%))
LOOP UNTIL onScreen(px%, py%)
NEXT star%
offdir% = 1
offset% = 6
LINE (left%, top% - 1)-(right%, top% - 1), 43
LINE (left%, bottom% + 1)-(right%, bottom% + 1), 43
DO
offset% = offset% + offdir%
IF 319 - 6 - 8 * LEN(msg$) <= offset% OR 6 >= offset% THEN
offdir% = -offdir%
END IF
' on computers that are much too fast, we'll draw multiple frames per
' retrace, and our framerate won't lock to anything reasonable just
' by waiting for retrace to begin. we instead have to wait for retrace
' to END, and then BEGIN AGAIN.
WAIT &H3DA, 8, 8 ' wait for vertical retrace to end
WAIT &H3DA, 8 ' wait for vertical retrace to begin
PUT (offset%, 6), hello, PSET
PUT (right% - offset% - 8 * LEN(msg$), 185), hello, PSET
FOR star% = 1 TO starcount%
' clear old star
px% = ProjectX(starX(star%), starZ(star%))
py% = ProjectY(starY(star%), starZ(star%))
PSET (px%, py%), 0
' move star
starZ(star%) = starZ(star%) - speed%
' draw new star
px% = ProjectX(starX(star%), starZ(star%))
py% = ProjectY(starY(star%), starZ(star%))
IF onScreen(px%, py%) AND 0 < starZ(star%) THEN
PSET (px%, py%), starZ(star%) \ 4
ELSE
starX(star%) = INT(RND * 320)
starY(star%) = INT(RND * 200)
starZ(star%) = 255
END IF
IF INKEY$ <> "" THEN ' exit on keypress
EXIT DO
END IF
NEXT star%
LOOP
SUB drawFrame
END SUB
SUB drawLetter (ox%, oy%)
FOR y% = 0 TO 7
FOR x% = 0 TO 6
READ a%
PSET (x% + ox%, y% + oy%), a%
NEXT x%
NEXT y%
END SUB
FUNCTION onScreen% (x%, y%)
SHARED top%, bottom%, left%, right%
onScreen% = 1
IF left% > x% OR x% > right% OR top% > y% OR y% > bottom% THEN
onScreen% = 0
END IF
END FUNCTION
FUNCTION ProjectX% (x%, z%)
SHARED halfwide%
ProjectX% = (x% - halfwide%) * 170 \ (z% + 85) + halfwide%
END FUNCTION
FUNCTION ProjectY% (y%, z%)
SHARED halftall%
ProjectY% = (y% - halftall%) * 170 \ (z% + 85) + halftall%
END FUNCTION