Category : BASIC Source Code
Archive   : QBNWS203.ZIP
Filename : ROMTEST.BAS

 
Output of file : ROMTEST.BAS contained in archive : QBNWS203.ZIP
'****************************************************************************
'* Routine to test the PrintROMtable subroutine *
'* *
'* Load QB by typing QB /Lqb to run within the environment *
'* *
'* Linking from the command-line: *
'* LINK YourProg+PrintROM,,nul,AnyLibraries+QB; *
'* *
'* You *** MUST *** $INCLUDE: 'printrom.bi' into every module that makes *
'* calls to PrintROMtable. Because this $INCLUDE file DIMs the TYPE, make *
'* sure that printrom.bi is the last $INCLUDE file used before your first *
'* executable statement. *
'****************************************************************************
'
REM $INCLUDE: 'printrom.bi'

DEFINT A-Z

'**** PrintROMtable needs to know what SCREEN type is used. Instruct it by
' setting PR.ScreenMode to the desired mode.

PR.ScreenMode = 12

ON ERROR GOTO BadMode
SCREEN PR.ScreenMode
ON ERROR GOTO 0

'**** Set PR.DefaultFile to 1 of 4 different disk, font files. File #1 is
' international ASCII set 128 through 254 (standard high ASCII found in
' most text books). Font file #2 is U.S. and contains such goodies as,
' registered trademark symbol (chr 169) and copyright symbol (chr 184).
' Font file #3 is Portuguese and file #4 is French-Canadian. If the
' integer, PR.DefaultFile, is not set, PrintROMtable will set it to #1.

PR.DefaultFile = 1

'**** Draw a simple pattern to show BGclr = 0 is non-destructive background.
IF PR.ScreenMode > 3 THEN PAINT (300, 200), 3 'Don't paint in CGA modes
y% = 200: Clr% = 0
FOR x% = 180 TO 460 STEP 20
CIRCLE (x%, 200), 100, Clr%
Clr% = Clr% + 1
IF Clr% = 3 THEN Clr% = Clr% + 1
NEXT

'**** Tells PrintROMtable to reset which disk-based font file to use
PR.ReadHiAscFile = -1: PrintROMtable a$, PR

PR.ReadHiAscFile = 2 'U.S. set contains copyright symbol chr$(184)

PR.Height = 8: PR.Tall = True
a$ = "Copyright " + CHR$(184) + " 1991, Lawrence Stone. All Rights Reserved."
PR.xAxis = 18: PR.yAxis = 135: PR.StepX = 10: PR.CharClr = 15
PR.Shadow = -1: PR.ItalicSlant = 0: PrintROMtable a$, PR

'**** Tell PrintROMtable to reset which disk-based font file to use - if CGA,
' then next use of high ASCII will force default (international symbols).
PR.ReadHiAscFile = -1: PrintROMtable a$, PR

PR.Height = 16: PR.Tall = False
a$ = "²²²ÛÝ û With Plenty of Help from His Friends û ÞÛ²²²"
PR.xAxis = 111: PR.yAxis = 155: PR.StepX = 7: PR.BGclr = 1
IF PR.ScreenMode < 7 THEN PR.BGclr = 0: PR.yAxis = 15
PrintROMtable a$, PR

IF PR.ScreenMode < 7 THEN GOTO LastAct

PR.Height = 8
a$ = CHR$(4) + "HELLO " 'Hello - right-hand italic
PR.xAxis = 207: PR.yAxis = 75: PR.StepX = 19: PR.BGclr = 7: PR.ItalicSlant = 2
PrintROMtable a$, PR

a$ = MID$(a$, 2, 5) + CHR$(4) 'Hello - left-hand italic
PR.ItalicSlant = -PR.ItalicSlant: PrintROMtable a$, PR

PR.ItalicSlant = 0
PR.xAxis = 52: PR.yAxis = 265: PR.StepX = 7: PR.CharClr = 15: PR.BGclr = 9
PrintROMtable " Until now, using ", PR 'Get fancy by mixing fonts on one line

'Notice xAxis not needed
PR.Height = 14: PR.yAxis = 258: PrintROMtable "TEXT FONTS", PR
PR.Height = 8: PR.yAxis = 265: PrintROMtable " with ", PR 'Also notice that the 1st
PR.Height = 16 'pixel starts at top-left
PR.yAxis = 258: PrintROMtable "GRAPHICS", PR 'so, we adjust yAxis 7
PR.Height = 8 'pixels to alternate
PR.yAxis = 265: PrintROMtable " was like ", PR 'between "Tall" & normal

PR.ItalicSlant = 1: PR.StepY = 2: PrintROMtable "Tripping Downstairs", PR
PR.StepY = 0: PrintROMtable "...", PR 'Notice xAxis & yAxis not needed

'**** Top-down & italic
PR.xAxis = 222: PR.yAxis = 280: PR.StepX = 0: PR.StepY = 10: PR.CharClr = 14
PR.BGclr = 2: PR.ItalicSlant = 2: PrintROMtable " Top to Bottom ", PR

'**** Go from bottom - up
PR.xAxis = 231: PR.yAxis = 430: PR.StepX = 0: PR.StepY = -10: PR.CharClr = 10
PR.BGclr = 256: PR.ItalicSlant = 0: PrintROMtable " Upside Down... ", PR

PR.xAxis = 247: PR.yAxis = 350: PR.StepX = 9: PR.StepY = 0: PR.BGclr = 7
PR.ItalicSlant = 0: PrintROMtable " Forward or ", PR

'**** Each character is backwards
PR.yAxis = 350: PR.StepX = 9: PR.CharClr = 14
PR.Backwards = -1: PrintROMtable "BACKWARD ", PR

PR.CharClr = 10: PR.Backwards = 0: PrintROMtable "Characters ", PR

a$ = " And Reverse Strings " 'String prints from right - left
PR.xAxis = 427: PR.yAxis = 380: PR.StepX = -PR.StepX: PR.CharClr = 11
PR.BGclr = 6: PR.ItalicSlant = -2: PrintROMtable a$, PR

'**** Reposition xAxis 7 pixels for forward display
PR.xAxis = 434: PR.StepX = -PR.StepX: PR.CharClr = 12: PR.BGclr = 9
PR.ItalicSlant = -PR.ItalicSlant: PrintROMtable a$, PR

a$ = " Inverted Images "
PR.xAxis = 250: PR.yAxis = 105: PR.CharClr = 15: PR.BGclr = 12
PR.ItalicSlant = -PR.ItalicSlant: PrintROMtable a$, PR

PR.xAxis = 250: PR.yAxis = 113: PR.BGclr = 1: PR.ItalicSlant = 2
PR.Inverted = -1: PrintROMtable a$, PR 'Now print it inverted

PR.Height = 8
a$ = "You can even Underline!" 'StepX = 7 is condenced font
PR.xAxis = 247: PR.yAxis = 410: PR.StepX = 7: PR.CharClr = 14: PR.BGclr = 0
PR.Inverted = 0: PR.ItalicSlant = 0: PR.UnderLine = -1: PrintROMtable a$, PR

'Show string inverted
PR.xAxis = 247: PR.yAxis = 419: PR.CharClr = 11: PR.Inverted = -1
PrintROMtable a$, PR

a$ = "WIDE Letters" 'Wide, italic & underlined
PR.xAxis = 235: PR.yAxis = 17: PR.StepX = 15: PR.CharClr = 14: PR.Inverted = 0
PR.ItalicSlant = 2: PR.Elongate% = 1: PrintROMtable a$, PR

PR.xAxis = 234: PR.yAxis = 26: PR.CharClr = 11: PR.Inverted = -1
PR.ItalicSlant = -PR.ItalicSlant: PrintROMtable a$, PR 'Show string inverted

PR.xAxis = 39: PR.yAxis = 41: PR.StepX = 29: PR.StepY = 2: PR.CharClr = 15
PR.BGclr = 5: PR.ItalicSlant = 0: PR.Inverted = 0: PR.UnderLine = 0
PR.Elongate% = 2: PrintROMtable "Double WID", PR 'Double wide stepping down

PR.xAxis = 332 'Step the rest up
PR.yAxis = 57: PR.StepY = -PR.StepY: PrintROMtable "E Letters!", PR

a$ = "STENCILS" 'Shadowed stencil
PR.xAxis = 5: PR.yAxis = 320: PR.StepX = 13: PR.StepY = 0: PR.CharClr = 14
PR.BGclr = 0: PR.Elongate% = 0: PR.Stencil% = -1: PrintROMtable a$, PR

PR.xAxis = 3: PR.yAxis = 330: PR.StepX = 19: PR.CharClr = 11: PR.Elongate% = 1
PrintROMtable a$, PR 'Wide stencil

PR.UnderLine = -1
PR.xAxis = 0: PR.StepX = 26: PR.yAxis = 350: PR.CharClr = 15: PR.Elongate% = 2
PrintROMtable a$, PR 'Underlined, double wide stencil

PR.xAxis = 0: PR.yAxis = 359: PR.CharClr = 10: PR.ItalicSlant = 2
PR.Inverted = -1: PrintROMtable a$, PR 'Invert and slant the stencil

PR.Height = 32 '32, underlined & double wide
a$ = "32 Height Letters": PR.Stencil% = 0: PR.BGclr = 12
PR.Inverted = 0: PR.UnderLine = -1: PR.ItalicSlant = 2
PR.xAxis = 71: PR.StepX = 29: PR.yAxis = 173: PR.CharClr = 15: PR.Elongate% = 2
PrintROMtable a$, PR

PR.Height = 28: a$ = "28 Height Letters": PR.ItalicSlant = 2
PR.xAxis = 71: PR.yAxis = 206: PR.BGclr = 11: PR.CharClr = 13
PR.UnderLine = 1: PrintROMtable a$, PR 'Tall and wide

PR.Height = 16: a$ = "16 Height Letters": PR.BGclr = 13: PR.CharClr = 14
PR.xAxis = 71: PR.yAxis = 239: PR.ItalicSlant = 3
PrintROMtable a$, PR 'Tall and normal width

PR.Height = 14: PR.StrikeThrough = -1 'Strike through letters
PR.xAxis = 247: PR.StepX = 10: PR.yAxis = 320: PR.ItalicSlant = 0
PR.Elongate% = 0: PR.UnderLine = 0: PR.BGclr = 0: PR.CharClr = 15
PrintROMtable "These are StrikeThrough characters", PR

PR.Height = 8: PR.xAxis = 185: PR.yAxis = 382: PR.StepX = -8
PR.Backwards = True: PR.StrikeThrough = 0
PrintROMtable "Read this with a MIRROR.", PR 'True mirror image!

PR.CharClr = 11
PR.xAxis = 2: PR.yAxis = 402: PR.StepX = 8: PR.Backwards = False
PrintROMtable "If you can read this...", PR 'True mirror image!

PR.xAxis = 2: PR.yAxis = 415: PR.CharClr = 12
a$ = "Your Just To Damn Close!"
PrintROMtable a$, PR

PR.xAxis = 2: PR.yAxis = 427: PR.Condensed = True
PrintROMtable a$, PR

LastAct:
PR.yAxis = 460: PR.BGclr = 3: GOSUB StrikeAnyKey

CLS

PR.Height = 32: PR.Tall = True '64, underlined & double wide
IF PR.ScreenMode > 2 THEN PR.BGclr = 6 ELSE PR.BGclr = 256
a$ = " REVIEW: ": PR.Shadow% = True
PR.UnderLine = -1: PR.ItalicSlant = 0: PR.Elongate% = 2
PR.xAxis = 181: PR.StepX = 30: PR.yAxis = 7: PR.CharClr = 14
PrintROMtable a$, PR

b$ = " High Double Wide"
c$ = " High Wide (Bold) Letters"
d$ = " High Normal Letters"
e$ = " High Condensed Letters"

FOR N = 1 TO 7
x1 = 67
IF PR.ScreenMode < 7 THEN x1 = x1 \ 2
LINE (1, x1)-(640, 301), 0, BF 'Clear screen below "Review" title
IF PR.ScreenMode > 2 THEN PR.BGclr = 9 ELSE PR.BGclr = 256
PR.UnderLine = 0: PR.ItalicSlant = 0: PR.CharClr = 14

IF N = 1 THEN
PR.Height = 32: PR.Tall = True '32 + Tall = 64
MID$(b$, 1, 2) = "64": MID$(c$, 1, 2) = "64" 'EGA will default to 56
MID$(d$, 1, 2) = "64": MID$(e$, 1, 2) = "64" 'CGA will default to 16
ELSEIF N = 2 THEN
PR.Height = 28: PR.Tall = True '28 + Tall = 56
MID$(b$, 1, 2) = "56": MID$(c$, 1, 2) = "56" 'CGA will default to 16
MID$(d$, 1, 2) = "56": MID$(e$, 1, 2) = "56"
ELSEIF N = 3 THEN
PR.Height = 32: PR.Tall = False 'EGA will default to 28
MID$(b$, 1, 2) = "32": MID$(c$, 1, 2) = "32" 'CGA will default to 8
MID$(d$, 1, 2) = "32": MID$(e$, 1, 2) = "32"
ELSEIF N = 4 THEN
PR.Height = 28 'CGA will default to 8
MID$(b$, 1, 2) = "28": MID$(c$, 1, 2) = "28"
MID$(d$, 1, 2) = "28": MID$(e$, 1, 2) = "28"
ELSEIF N = 5 THEN
PR.Height = 16 'Use 8 + Tall for CGA
MID$(b$, 1, 2) = "16": MID$(c$, 1, 2) = "16"
MID$(d$, 1, 2) = "16": MID$(e$, 1, 2) = "16"
ELSEIF N = 6 THEN
PR.Height = 14 'CGA will default to 8
MID$(b$, 1, 2) = "14": MID$(c$, 1, 2) = "14"
MID$(d$, 1, 2) = "14": MID$(e$, 1, 2) = "14"
ELSEIF N = 7 THEN
PR.Height = 8
MID$(b$, 1, 2) = " 8": MID$(c$, 1, 2) = " 8"
MID$(d$, 1, 2) = " 8": MID$(e$, 1, 2) = " 8"
b$ = MID$(b$, 2): c$ = MID$(c$, 2)
d$ = MID$(d$, 2): e$ = MID$(e$, 2)
END IF

FOR j = 1 TO 5
IF j% = 1 THEN
PR.Elongate% = 2
PR.xAxis = 2: PR.StepX = 30: PR.yAxis = 67
IF PR.ScreenMode < 7 THEN PR.yAxis = PR.yAxis \ 2
PrintROMtable b$, PR
ELSEIF j% = 2 THEN
PR.Elongate% = 1
PR.xAxis = 2: PR.StepX = 19: PR.yAxis = 127
IF PR.ScreenMode < 7 THEN PR.yAxis = PR.yAxis \ 2
PrintROMtable c$, PR
ELSEIF j% = 3 THEN
PR.Elongate% = 0
PR.xAxis = 2: PR.StepX = 14: PR.yAxis = 187
IF PR.ScreenMode < 7 THEN PR.yAxis = PR.yAxis \ 2
PrintROMtable d$, PR
ELSEIF j% = 4 THEN
PR.Condensed = True
PR.xAxis = 2: PR.StepX = 10: PR.yAxis = 247
IF PR.ScreenMode < 7 THEN PR.yAxis = PR.yAxis \ 2
PrintROMtable e$, PR
ELSEIF j% = 5 THEN
PR.Height = 8: PR.Tall = False: PR.Condensed = False
PR.yAxis = 290: PR.BGclr = 0
IF PR.ScreenMode < 7 THEN PR.yAxis = PR.yAxis \ 2
GOSUB StrikeAnyKey
END IF
NEXT
NEXT

b$ = ""
FOR N = 128 TO 255
b$ = b$ + CHR$(N) + " "
NEXT
b$ = RTRIM$(b$)

FOR N = 1 TO 4
x1 = 67
IF PR.ScreenMode < 7 THEN x1 = x1 \ 2 - 6
LINE (1, x1)-(640, 310), 0, BF 'Clear screen below "Review" title
IF PR.ScreenMode > 2 THEN PR.BGclr = 2 ELSE PR.BGclr = 256
PR.UnderLine = 0: PR.ItalicSlant = 0: PR.CharClr = 14
PR.ReadHiAscFile = True: PrintROMtable "", PR
PR.Height = 8: PR.Tall = True '8 + Tall = 16

PR.StepX = 10: PR.yAxis = 70
IF PR.ScreenMode < 7 THEN PR.yAxis = PR.yAxis \ 2 - 6

IF N = 1 THEN
PR.ReadHiAscFile = N: PrintROMtable "", PR
a$ = " High ASCII Font Set = rsCODES.INT (International) "
ELSEIF N = 2 THEN
PR.ReadHiAscFile = N: PrintROMtable "", PR
a$ = " High ASCII Font Set = rsCODES.US (United States)"
ELSEIF N = 3 THEN
PR.ReadHiAscFile = N: PrintROMtable "", PR
a$ = " High ASCII Font Set = rsCODES.POR (Portuguese)"
ELSEIF N = 4 THEN
PR.ReadHiAscFile = N: PrintROMtable "", PR
a$ = " High ASCII Font Set = rsCODES.CAN (French-Canadian)"
END IF
PR.xAxis = 1: PrintROMtable a$, PR

IF PR.ScreenMode > 2 THEN PR.BGclr = 9 ELSE PR.BGclr = 256: PR.Tall = False

a$ = MID$(b$, 1, 57): PR.xAxis = 2: PR.yAxis = 100
IF PR.ScreenMode < 7 THEN PR.yAxis = PR.yAxis \ 2
PrintROMtable a$, PR

a$ = MID$(b$, 59, 57): PR.xAxis = 2: PR.yAxis = 118
IF PR.ScreenMode < 7 THEN PR.yAxis = 67
PrintROMtable a$, PR

a$ = MID$(b$, 117, 57): PR.xAxis = 2: PR.yAxis = 136
IF PR.ScreenMode < 7 THEN PR.yAxis = 83
PrintROMtable a$, PR

a$ = MID$(b$, 175, 57): PR.xAxis = 2: PR.yAxis = 154
IF PR.ScreenMode < 7 THEN PR.yAxis = 100
PrintROMtable a$, PR

a$ = MID$(b$, 233, 23): PR.xAxis = 2: PR.yAxis = 172
IF PR.ScreenMode < 7 THEN PR.yAxis = 117
PrintROMtable a$, PR

PR.yAxis = 290: PR.BGclr = 0

IF PR.ScreenMode < 7 THEN PR.yAxis = PR.yAxis \ 2
GOSUB StrikeAnyKey
NEXT

END

'******************************* Subroutines ******************************

StrikeAnyKey:
PR.Condensed = False: PR.Height = 8: PR.ItalicSlant = 2
PR.xAxis = 200: PR.StepX = 9: PR.CharClr = 15
PrintROMtable "Strike any key to continue...", PR 'Normal lettering

DO WHILE LEN(INKEY$) = False 'A blinking display
GOSUB Count4Ticks
IF LEN(INKEY$) THEN EXIT DO
PR.xAxis = 434 'Set xAxis to erase last 3 chars

'**** yAxis + 12 to account for character height + shadow.
' xAxis -2 to account for PrintROMtable automatic line positioning.
LINE (PR.xAxis - 3, PR.yAxis)-(468, PR.yAxis + 18), PR.BGclr, BF
GOSUB Count4Ticks
PrintROMtable "...", PR 'Blink the dots only
LOOP
RETURN

Count4Ticks: 'Routine to pause for 4 ticks (approx .2 sec)
TestTick% = 0 'Set TestTick% to zero
DEF SEG = 0
WHILE TestTick% < 4 'Pause for four ticks of the clock
lastTick% = Tick% 'This is the variable we use to adjust count
Tick% = PEEK(&H46C) 'Get a tick from the clock.

'**** Prevents endless loop when rolling past midnight.
IF lastTick% <> Tick% THEN TestTick% = TestTick% + 1
WEND
DEF SEG
RETURN

BadMode:
z% = ERR 'Reset the ERR
IF PR.ScreenMode = 12 THEN 'If mode 12 produced error try 9
PR.ScreenMode = 9
ELSEIF PR.ScreenMode = 9 THEN 'If mode 9 produced error try 7
PR.ScreenMode = 7
ELSEIF PR.ScreenMode = 7 THEN 'If mode 7 produced error try 2
PR.ScreenMode = 2
ELSE 'Don't know what it is so quit
Quit% = True
END IF
IF NOT Quit% THEN RESUME 'We're still OK so try again

SCREEN 0 'Either no graphics or Herc so END
CLS
PRINT "CGA, EGA, or VGA Monitor Required to Test Run PrintROMtable"
PRINT "Program Aborted"
END



  3 Responses to “Category : BASIC Source Code
Archive   : QBNWS203.ZIP
Filename : ROMTEST.BAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/