home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
QBAS
/
PRINTROM.ZIP
/
ROMTEST.BAS
< prev
next >
Wrap
BASIC Source File
|
1991-09-03
|
17KB
|
394 lines
'****************************************************************************
'* 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