# Category : BASIC Source Code

Archive : PRINTROM.ZIP

Filename : PRINTROM.BAS

ax AS INTEGER

bx AS INTEGER

cx AS INTEGER

dx AS INTEGER

bp AS INTEGER

si AS INTEGER

di AS INTEGER

flags AS INTEGER

ds AS INTEGER

es AS INTEGER

END TYPE

DECLARE SUB InterruptX (intnum AS INTEGER, inreg AS RegTypeX, outreg AS RegTypeX)

' $INCLUDE: 'printrom.bi'

DIM SHARED BitValue(15) AS INTEGER 'Create an array for bit values

DEFINT A-Z

SUB PrintROMtable (a$, PR AS PrntROM) STATIC

'****************************************************************************

'* PrintROMtable Subroutine *

'* *

'* BY: Larry Stone 1991 *

'* INSPIRED BY: Code from PC Magazine posted in the Quik_BAS inter- *

'* national echo by Richard Randles. 1991 *

'* CONTRIBUTORS: Rob Smetana @ 914/201 1991 - provided "ItalicSlant" *

'* and language for extended character sets *

'* for CGA monitors in SCREEN 0 or 1. Note *

'* that you can force the use of these *

'* high character sets using ReadHiAscFile *

'* Francois Roy - provided example code for "Elongate" *

'* Mike Kelly - provide code to write 8, 14, 16, 28 & 32 *

'* pixel height characters. His code also *

'* enables printing high ASCII set (>= 128) *

'* (except for CGA using 8 "Height" chars.) *

'* Bill Beasley - provided code for "Tall" which doubles *

'* pixel height, effectively providing *

'* extended character heights of 16, 28, *

'* 32, 56, and 64 pixels. *

'* Larry Stone provided all of the rest of this code. *

'* *

'* Passed as argument variable: *

'* ---------------------------- *

'* a$ String of characters to print. *

'* PR 106 byte TYPE variable PrntROM, DIMmed as PR, *

'* containing the following elements: *

'* *

'* Passed as TYPE variable (defined in 'printrom.bi'): *

'* --------------------------------------------------- *

'* *

'* PR.xAxis Starting column, in pixel points. *

'* PR.yAxis Starting row in pixel points. *

'* PR.StepX Count from 1st dot of character, right/left # pixels. *

'* Example: 8 = 8 right; -8 = 8 left (prints reverse). *

'* PR.StepY Count from 1st dot of character, down/up # pixels. *

'* Example: 1 = 1 down; -8 = 8 up (prints bottom - up). *

'* PR.CharClr The color to make each character. *

'* PR.BGclr Non-zero values determine the background color *

'* for the string. Background is neutral when BGclr is *

'* set to 0. Set BGclr = 256 for black background. *

'* PR.Shadow True or false Boolian variable. *

'* PR.ItalicSlant Set to zero or 7 or -7 for no slant. Positives *

'* create a forward slant (right-handed). Negative *

'* numbers for backward slant (left-handed). Maximum *

'* slant is 1 or -1. An attractive italic is 2 or -2. *

'* PR.Inverted True or false Boolean variable - turns characters *

'* upside down. *

'* PR.Backwards True or false Boolean variable - makes individual *

'* characters of a string print backwards. *

'* PR.Underline True of false Boolean variable. *

'* PR.Elongate Zero for normal size character, set to 1 for bold *

'* characters, set to 2 = double wide (truly fat). *

'* PR.Stencil True or false Boolean variable - makes stencil *

'* PR.Height An integer specified as 8, 14, 16, 28, or 32. This *

'* the height, in pixels, of the character printed. *

'* NOTE: CGA can only print 8. Use PR.Tall for 16. *

'* NOTE: EGA cannot do 16 or 32. PrintROMtable will force *

'* 16 to 14 and will force 32 to 28. EGA can access *

'* 16 by using 8 with Tall. *

'* PR.Tall Boolean variable that doubles pixel height effec- *

'* providing pixels heights of 16, 28, 32, 56, and 64. *

'* NOTE: CGA can only access 16. *

'* NOTE: EGA cannot access 32 or 64. *

'* PR.StrikeThrough True or false Boolean variable - a dash is *

'* placed in the middle of each character. *

'* PR.Condensed True or False Boolean variable - forces 8 scan line *

'* character into four scan lines. Not very readable but *

'* can be used for superscripts/subscripts or that fine, *

'* legal (and unreadable) print in contracts agreements. *

'* Also useful for printer preview modes. *

'* PR.ForceAddress True or False Boolean variable to force ROM charac- *

'* ter shape table address to &HFFA6. Set this to true *

'* to force systems to this memory segment. *

'* PR.ScreenMode Integer variable that equals the SCREEN mode used. *

'* YOU MUST SUPPLY THIS VARIABLE if you intend to use *

'* screen modes above CGA ("0" defaults to CGA font sizes). *

'* At the top of your code, do something like: *

'* PR.ScreenMode = 9 *

'* SCREEN PR.ScreenMode *

'* PR.DefaultFile Integer variable that defines which font file the *

'* program defaults to (for access to chars > 127). *

'* PR.DiskFontLoc String defining path to the disk font files. If *

'* the font files are not in your program's default path, *

'* then this variable need to be addressed before your *

'* program makes it's first call to PrintROMtable. *

'* PR.ReadHiAscFile Integer variable to force characters > 127 to be *

'* read from a font file. Use this feature with any type *

'* monitor (CGA/EGA/VGA) to force any special characters *

'* from font file to memory, i.e., a true copyright symbol *

'* (US file, ASCII = 184), trade mark (US, ASCII = 169). *

'* You can also build your own font files then load your *

'* special built fonts as the upper 128 characters. *

'* *

'* PrintROMtable DOES NOT CHECK FOR EXISTENCE OF: *

'* *

'* ReadHiAscFile = 1: *

'* File = rsCODES.INT - International (we want) *

'* ReadHiAscFile = 2: *

'* File = rsCODES.US - United States *

'* ReadHiAscFile = 3: *

'* File = rsCODES.POR - Portuguese *

'* ReadHiAscFile = 4: *

'* File = rsCODES.CAN - French-Canadian *

'* *

'* It is your responsibility to have your code check for *

'* the appropriate file above unless your program does not *

'* operate on CGA systems and/or, if your program does *

'* not access the upper 128 ASCII characters and/or, your *

'* program doesn't set ReadHiAscFile. *

'* *

'* ReadHiAscFile = -1 *

'* Resets this subprogram to use ROM BIOS table for *

'* characters above ASCII 127. Usage: *

'* PR.ReadHiAscFile = -1: PrintROMtable a$, PR *

'* *

'* OUT: 1) String of characters printed to the graphics screen. *

'* 2) Location and slant of displayed string are pixel based. *

'* 3) Strings can be printed normal, reverse, top to bottom and *

'* upside down. *

'* 4) Strings can have both foreground and background colors or *

'* possess a neutral, non-destructive background. *

'* 5) "CPI" can be adjusted along horizontal or vertical planes *

'* with StepX and StepY variables (ie, StepX = 7 would be a *

'* condenced font, StepX = 8 a normal font, etc). *

'* 6) Characters can be printed with a shadow. *

'* 7) Characters can be printed with "right-hand" or "left-hand" *

'* italicized slant. *

'* 8) Characters can be inverted for mirror images along the *

'* verticle plane (like a reflection on a lake). *

'* 9) Characters can be printed backwards for mirror images on *

'* horizontal plane (horizontal mirror images should have *

'* StepX set to a negative value for a "true mirror image"). *

'* 10) Characters can be elongate by 2 or 4 times normal length. *

'* 11) Characters can be displayed as "stencil" characters. *

'* 12) Characters can be displayed with a strike through mark. *

'* 13) Characters can be 8, 14, 16, 28, or 32 pixels high. *

'* 14) Characters can be printed "Tall" effectively producing hights *

'* of 16, 28, 32, 56, or 64 pixels high. *

'* 15) Characters can be printed "Condensed" for use as super or sub *

'* script type or printer preview modes. *

'* 16) The high ASCII character set (128 through 254) can be altered *

'* from 1 of four, pre-defined files (1024 bytes each). *

'* *

'****************************************************************************

IF NOT BitsCreated THEN

BitValue(False) = 1 'Set bit zero

FOR N% = 1 TO 14 'Set bits 1 through 14

BitValue(N%) = BitValue(N% - 1) * 2

NEXT

BitValue(15) = -32768 'Set bit 15

DIM Mask%(15), TallMask%(64) 'Create arrays for scan lines

BitsCreated = True 'Flag that bits are created

END IF

DIM reg AS RegTypeX 'Establish the register variables

extX% = PR.StepX: extY% = PR.StepY 'Don't destroy StepX or StepY

dub% = False 'Reset dub% variable

'**** Can't accept a zero

IF PR.ItalicSlant = False THEN PR.ItalicSlant = 7

'**** If PR.ScreenMode < 7 then PR.Height is automatically set to 8

' and ROM address used is &HFFA6.

IF PR.ScreenMode < 7 THEN PR.Height = 8: HiAscii = True

'**** If no default file established then set default to 1 (international)

IF PR.DefaultFile = False THEN PR.DefaultFile = 1

'**** If instructed to read high ASCII or, if HiAscii set but we haven't

' acknowledged HiAsciRead (CGA will cause this condition when CGA

' system first calls this routine) then read the appropriate file.

IF PR.ReadHiAscFile OR (HiAscii AND NOT HiAsciiRead) THEN

HiAscii = True 'Set flag

'**** If ReadHiAscFile not established, assign it to DefaultFile

IF PR.ReadHiAscFile = False THEN PR.ReadHiAscFile = PR.DefaultFile

'**** If DiskFontLoc hasn't been assigned then QB will have

' initialized the string with character zeros. Clear zeros!

N = INSTR(PR.DiskFontLoc, CHR$(0))

IF N THEN MID$(PR.DiskFontLoc, N) = SPACE$(LEN(PR.DiskFontLoc) - N + 1)

'**** If disk fonts have an assigned path...

Temp$ = RTRIM$(PR.DiskFontLoc)

IF LEN(Temp$) THEN

IF NOT RIGHT$(Temp$, 1) = "\" THEN Temp$ = Temp$ + "\"

END IF

'**** You could create your own 1024 byte font files and add them here

SELECT CASE PR.ReadHiAscFile 'Select a font style to use

CASE -1 'No special chars - use ROM table

HiAsciiRead = False: HiAscii = False

PR.ReadHiAscFile = False: EXIT SUB

CASE 1 'International (our default)

FontFile$ = Temp$ + "rsCODES.INT"

CASE 2 'United States

FontFile$ = Temp$ + "rsCODES.US"

CASE 3 'Portuguese

FontFile$ = Temp$ + "rsCODES.POR"

CASE 4 'French-Canadian

FontFile$ = Temp$ + "rsCODES.CAN"

CASE ELSE

PRINT "Error - Font File Not Defined!": END

END SELECT

PR.ReadHiAscFile = False 'Clear flag

j% = FREEFILE 'Get a handle

OPEN FontFile$ FOR BINARY AS #j% 'Open with this handle

font$ = SPACE$(1024) '...Our fonts need just 1024 bytes (128 * 8).

GET #1, , font$: CLOSE #j% 'Close file with handle j%

HiAsciiRead = True 'Flag we've read 'em

END IF

'**** EGA screens cannot access 16 pixel high characters so force 14

IF PR.ScreenMode < 12 AND PR.ScreenMode > 2 THEN

IF PR.Height = 16 THEN PR.Height = 14

IF PR.Height = 32 THEN PR.Height = 28

END IF

'**** Figure out where the font is

SELECT CASE PR.Height

CASE 8 ' 8x8 font

reg.bx = &H300

CASE 14, 28 ' 8x14 font or 8x14 font double high

reg.bx = &H200

CASE 16, 32 ' 8x16 font or 8x16 font double high

reg.bx = &H600

CASE ELSE

CLS : PRINT "Invalid Character Size": END

END SELECT

IF PR.Height > 16 THEN dub% = True

IF dub% THEN

Two% = 2

one% = 1

h% = PR.Height \ Two%

ELSE

h% = PR.Height

Two% = 1

one% = False

END IF

' **** Get ROM segment for character shape tables

reg.ax = &H1130

InterruptX &H10, reg, reg

ofst& = reg.bp

sgmt& = reg.es

IF PR.ForceAddress OR PR.ScreenMode < 7 THEN sgmt& = &HFFA6

DEF SEG = sgmt& 'ROM segment for character shape tables

FOR i% = 1 TO LEN(a$)

IF PR.BGclr THEN 'Color background

'**** Backgrounds equal to 256 are really color zero.

IF PR.BGclr = 256 THEN BG% = False ELSE BG% = PR.BGclr

'**** Prevent coloring background beyond range of string.

IF i% = LEN(a$) THEN

IF PR.Elongate = 1 THEN

extX% = extX% \ 2 + 2

ELSEIF NOT PR.Elongate = 2 THEN

extX% = False

END IF

extY% = False

END IF

'**** Adjust box start positions for reverse writing.

IF extY% < False THEN stpY% = 7 ELSE stpY% = False

IF extX% < False THEN stpX% = 7 ELSE stpX% = False

'**** Set a few more variables to properly manipulate background

' border areas, as well as, adjust for elongated characters

adjust% = False

N% = False

Tx% = 1

IF dub% THEN

adjust% = -4

ELSEIF PR.Height > 8 THEN

Tx% = 2: adjust% = True: N% = h% \ 2

ELSEIF PR.Height = 8 AND PR.Tall AND PR.StepY < False AND PR.Elongate = False THEN

Tx% = 2

END IF

seven% = 7

IF PR.Tall THEN Tx% = Tx% * 2

T% = Two% * Tx%

IF PR.Condensed THEN

T% = 1

IF PR.Height = 8 THEN seven% = 4 'Gets pretty tiny

IF PR.Tall AND PR.Height > 8 THEN T% = T% * 2

END IF

IF PR.Elongate <> 2 THEN

Twoo% = False

Ttoo% = False

less2% = False

ELSE

Twoo% = 2

less2% = Twoo%

IF StepY% > True THEN Ttoo% = False ELSE Ttoo% = Ttoo%

END IF

IF PR.xAxis > True THEN ySlant = extY% ELSE ySlant = False

'**** Box and paint a background for the character.

' Drawing two boxes handles BG for any direction printed.

LINE (PR.xAxis + extX% + Twoo%, PR.yAxis + ySlant)-(PR.xAxis + stpX% + Ttoo%, PR.yAxis + N% + stpY% * Two% * Two%), BG%, BF

LINE (PR.xAxis + stpX% + Twoo% - less2%, PR.yAxis + stpY%)-(PR.xAxis + 7 + extX%, PR.yAxis + seven% * Two% * T% + extY% - Two%), BG%, BF

END IF

'**** Get how far the character's address is within the table

addr% = ofst& + ASC(MID$(a$, i%, 1)) * h%

IF PR.ForceAddress OR PR.ScreenMode < 7 THEN addr% = 8 * ASC(MID$(a$, i%)) + 14

z% = h% - 1 'Establish last scan line to use

FOR j% = False TO z%

MidA = ASC(MID$(a$, i%, 1)) 'Get ASCII value of char

IF HiAscii AND MidA > 128 THEN

IF j% < 8 THEN

'**** Get Font$ scan line as long integer

Msk& = ASC(MID$(font$, (MidA - 128) * 8 + j% + 1, 1)) * 256&

'**** Set into range of INTEGER numbers

Mask% = Msk& + 65536 * (Msk& > 32767)

ELSE

Mask = False 'Set mask as zero

END IF

Mask(j%) = Mask% 'Set into the mask array

ELSE

Mask(j%) = PEEK(addr% + j%) 'Load scan lines from ROM BIOS

END IF

NEXT

IF PR.Condensed THEN

'**** Set Condensed fonts

k% = 0

FOR j% = False TO z% STEP 2

Mask(k%) = Mask(j% + 1)

k% = k% + 1

NEXT

FOR j% = (z% + 1) \ 2 TO z% 'Clear rest of Mask array.

Mask(j%) = False

NEXT

END IF

IF PR.Tall THEN

'**** Load TallMask

FOR j% = False TO z% * 2 STEP 2

TallMask(j%) = Mask(j% \ 2)

TallMask(j% + 1) = Mask(j% \ 2)

NEXT

z% = z% * 2 'Double scan lines for Tall letters

END IF

k% = z%

FOR j% = False TO z%

'**** Establish either j% or k% as our scan line counter.

' Use k%=j% for counting up and k%=k% for countin down

IF NOT PR.Inverted THEN k% = j% 'If not mirror then j% is scan line

'**** Use either the Tall mask or normal mask

IF NOT PR.Tall THEN Mask% = Mask%(k%) ELSE Mask% = TallMask(k%)

'**** Shift bits 8 places if not high ASCII from font file

IF NOT (HiAscii AND MidA > 128) THEN Mask% = Mask% * 128

IF PR.Backwards THEN

N1% = 15

FOR N% = 8 TO 11

t1% = TestBit%(Mask%, N%) 'Test low bit

t2% = TestBit%(Mask%, N1%) 'Test high bit

SetBit Mask%, N1%, t1% 'Set high bit to low value

SetBit Mask%, N%, t2% 'Set low bit to high value

N1% = N1% - 1

NEXT

END IF

'**** If "Stencil" then turn off middle bit of each scan line.

IF PR.Stencil AND PR.Elongate < 2 THEN SetBit Mask%, 11, False

'**** Calculate the amount of slant for italic characters

Islant% = j% \ PR.ItalicSlant

'**** Calculate variables needed for a "left-handed" italic

IF PR.ItalicSlant < False THEN

Islant% = -Islant% 'Make number positive

Mask% = Mask% \ BitValue(Islant%) 'Adjust the mask

Islant% = 2 'Neutralize slant variable

Msk& = Mask% * 2& 'Shift left 1 bit

Mask% = Msk& + 65536 * (Msk& > 32767) 'Put into INTEGER range

END IF

'**** If "UnderLine" or "StrikeThrough" then turn on all bits in

' the appropriate row of bits.

IF PR.UnderLine THEN

IF PR.Condensed THEN

IF NOT PR.Tall AND ((h% = 8 AND k% = 5) OR (h% = 16 AND k% = 7) OR (h% = 14 AND k% = 6)) THEN

Mask% = True

ELSEIF PR.Tall AND ((h% = 8 AND k% = 5) OR (h% = 14 AND k% = 11) OR (h% = 16 AND k% = 12)) THEN

Mask% = True

END IF

ELSE

IF NOT PR.Tall AND ((h% = 8 AND k% = 6) OR (h% = 16 AND k% = 13) OR (h% = 14 AND k% = 11)) THEN

Mask% = True

ELSEIF PR.Tall AND ((h% = 8 AND k% = 13) OR (h% = 14 AND k% = 22) OR (h% = 16 AND k% = 24)) THEN

Mask% = True

END IF

END IF

END IF

IF PR.StrikeThrough THEN

IF PR.Condensed THEN

IF NOT PR.Tall AND ((h% = 8 AND k% = 2) OR (h% = 16 AND k% = 4) OR (h% = 14 AND k% = 3)) THEN

Mask% = True

ELSEIF PR.Tall AND ((h% = 8 AND k% = 3) OR (h% = 14 AND k% = 7) OR (h% = 16 AND k% = 7)) THEN

Mask% = True

END IF

ELSE

IF NOT PR.Tall AND ((h% = 8 AND k% = 4) OR (h% = 16 AND k% = 7) OR (h% = 14 AND k% = 7)) THEN

Mask% = True

ELSEIF (h% = 8 AND k% = 8) OR (h% = 14 AND k% = 14) OR (h% = 16 AND k% = 16) THEN

Mask% = True

END IF

END IF

END IF

L% = False: R% = L%: L1% = L%: R1% = L% 'Reset Elongate variables

IF Mask% THEN 'If Mask isn't cleared then print it

'**** If we've used Islant then clean it up

IF Islant% > 1 AND PR.ItalicSlant = 7 THEN Islant% = 1

GOSUB CalcXYparams

'**** If shadow then displace line by 2 pixels and draw with

' black style mask

IF PR.Elongate < 1 AND NOT dub% THEN

'**** Below is Boolean logic and is faster than:

' IF (x7%) - (XlessI%) < 8 THEN N% = 7 ELSE N% = 6

N% = 6 - ((x7%) - (XlessI%) < 8)

IF PR.Shadow THEN LINE (PR.xAxis + N% + 2, YandJlessAd% + 2)-(XlessI% + 2, YandJlessAd% + 2), False, , Mask%

'**** Draw the masked line with the assigned color attribute

LINE (PR.xAxis + N%, YandJlessAd%)-(XlessI%, YandJlessAd%), PR.CharClr, , Mask%

ELSEIF PR.Elongate THEN

GOSUB SetElongated

ELSEIF dub% THEN

'**** Prevent an inappropriate adjustment

IF PR.Inverted AND Islant% = False AND PR.ItalicSlant = 7 AND PR.Height = 32 THEN Islant% = 1

GOSUB CalcXYparams

IF PR.Shadow% THEN

LINE (PR.xAxis + 9, YtwoJ% + Two%)-(XlessI% + Two%, YtwoJ% + Two%), False, , Mask%

LINE (PR.xAxis + 10, YtwoJ1% + Two%)-(XlessI% + Two%, YtwoJ1% + Two%), False, , Mask%

END IF

LINE (x7%, YtwoJ%)-(XlessI%, YtwoJ%), PR.CharClr, , Mask%

LINE (PR.xAxis + 8, YtwoJ1%)-(XlessI%, YtwoJ1%), PR.CharClr, , Mask%

END IF

END IF

'**** Adjust location of the x axis per certain variables

IF HiAscii AND ASC(MID$(a$, i%, 1)) > 128 AND NOT PR.Tall THEN

IF k% = 6 THEN PR.xAxis = PR.xAxis + 1

ELSEIF h% = 8 AND PR.Tall AND Islant% = False AND NOT PR.Inverted THEN

IF k% = h% \ 2 + 2 AND (PR.StepY = False OR PR.Elongate) THEN PR.xAxis = PR.xAxis + 1

ELSEIF h% > 8 AND Islant% = False THEN

IF h% = 14 AND k% = h% \ 2 - 1 AND PR.StepY = False THEN

PR.xAxis = PR.xAxis + 1

ELSEIF h% = 16 AND k% = h% \ 2 - 2 AND PR.StepY = False THEN

PR.xAxis = PR.xAxis + 1

END IF

ELSEIF h% = 8 AND PR.Tall AND PR.ItalicSlant = 7 AND PR.Inverted THEN

IF k% = h% THEN PR.xAxis = PR.xAxis + 1

END IF

IF PR.Inverted THEN k% = k% - 1 'If "Inverted" then decrement k%

NEXT

'**** INC xAxis and yAxis by values extX% and extY%

PR.xAxis = PR.xAxis + extX%

PR.yAxis = PR.yAxis + extY%

NEXT

DEF SEG 'Return to BASIC DGROUP

'**** Adjust the ending xAxis pixel location to correspond to the

' correct location associated with the next letter that might

' be displayed along the same axis.

IF h% > 8 THEN PR.xAxis = PR.xAxis + h% \ 4 - 1

IF PR.Elongate = 1 THEN

PR.xAxis = PR.xAxis + PR.StepX \ 4 + 1

ELSEIF PR.Elongate = 2 THEN

PR.xAxis = PR.xAxis + PR.StepX \ 8

ELSEIF (PR.ItalicSlant = 7 OR PR.ItalicSlant = -7) THEN

PR.xAxis = PR.xAxis + PR.StepX - 1

ELSEIF PR.StepY THEN

PR.xAxis = PR.xAxis + PR.StepX + 1

END IF

EXIT SUB

SetElongated:

StepFactor% = PR.Elongate * 2

N1% = 15

FOR N% = 15 TO StepFactor% + 10 STEP -1 'Left side of left half

BitOn% = TestBit%(Mask%, N%)

IF BitOn% THEN

SetBit L%, N1%, BitOn%

SetBit L%, N1% - 1, BitOn%

IF StepFactor% > 2 THEN

SetBit L%, N1% - 2, BitOn%

SetBit L%, N1% - 3, BitOn%

END IF

END IF

N1% = N1% - StepFactor%

NEXT

N1% = 15: t1% = N%

IF StepFactor% = 2 THEN t2% = 7 ELSE t2% = 12

FOR N% = t1% TO t2% STEP -1 'Right side of left half

BitOn% = TestBit%(Mask%, N%)

IF BitOn% THEN

SetBit R%, N1%, BitOn%

SetBit R%, N1% - 1, BitOn%

IF StepFactor% > 2 THEN

IF PR.Stencil AND N% = t2% THEN BitOn% = False ELSE BitOn% = True

SetBit R%, N1% - 2, BitOn%

SetBit R%, N1% - 3, BitOn%

END IF

END IF

IF PR.Stencil AND PR.Elongate = 1 AND N% = t2% THEN SetBit R%, N1% + 6, False

N1% = N1% - StepFactor%

NEXT

IF StepFactor% > 2 THEN

N1% = 8

FOR N% = 11 TO 10 STEP -1 'Left side of right half

BitOn% = TestBit%(Mask%, N%)

IF BitOn% THEN

SetBit L1%, N1%, BitOn%

SetBit L1%, N1% - 1, BitOn%

SetBit L1%, N1% - 2, BitOn%

SetBit L1%, N1% - 3, BitOn%

END IF

IF PR.Stencil AND N% = 11 THEN SetBit L1%, N1%, False

N1% = N1% - 4

NEXT

Bit9on = TestBit%(Mask%, 8) 'Left side of R1

Bit8on = TestBit%(Mask%, 9) 'Right side of R1

IF Bit9on THEN 'Gets tricky - doesn't it

N1% = 4

SetBit R1%, N1%, Bit9on

SetBit R1%, N1% - 1, Bit9on

SetBit R1%, N1% - 2, Bit9on

SetBit R1%, N1% - 3, Bit9on

END IF

IF Bit8on THEN

N1% = 7

SetBit R1%, N1%, Bit8on

SetBit R1%, N1% - 1, Bit8on

SetBit R1%, N1% - 2, Bit8on

END IF

END IF

'**** Allow underline/StrikeThrough to be long enough to form a

' continuous line (assuming spacing is within reason).

IF Mask% = True THEN L% = True: L1% = True: R% = True: R1% = True

IF Mask% = True THEN ExtR = 2 ELSE ExtR = False

IF PR.Shadow THEN

LINE (PR.xAxis + 9, YtwoJ2%)-(XlessI% + 2, YtwoJ2%), False, , L%

LINE (PR.xAxis + 17, YtwoJ2%)-(XlessI% + 9, YtwoJ2%), False, , R%

LINE (PR.xAxis + 10, YtwoJ12%)-(XlessI% + 2, YtwoJ12%), False, , L%

LINE (PR.xAxis + 18, YtwoJ12%)-(XlessI% + 9, YtwoJ12%), False, , R%

IF StepFactor% > 2 THEN

LINE (PR.xAxis + 25, YtwoJ2%)-(XlessI% + 9, YtwoJ2%), False, , L1%

LINE (PR.xAxis + 33, YtwoJ2%)-(XlessI% + 16, YtwoJ2%), False, , R1%

LINE (PR.xAxis + 26, YtwoJ12%)-(XlessI% + 9, YtwoJ12%), False, , L1%

LINE (PR.xAxis + 34, YtwoJ12%)-(XlessI% + 16, YtwoJ12%), False, , R1%

END IF

END IF

'**** Draw the masked lines with the assigned color attribute

LINE (x7%, YtwoJ%)-(XlessI%, YtwoJ%), PR.CharClr, , L%

LINE (PR.xAxis + 15, YtwoJ%)-(XlessI% + 7, YtwoJ%), PR.CharClr, , R%

LINE (PR.xAxis + 8, YtwoJ1%)-(XlessI%, YtwoJ1%), PR.CharClr, , L%

LINE (PR.xAxis + 16, YtwoJ1%)-(XlessI% + 7, YtwoJ1%), PR.CharClr, , R%

IF StepFactor% > 2 THEN

LINE (PR.xAxis + 23, YtwoJ%)-(XlessI% + 7, YtwoJ%), PR.CharClr, , L1%

LINE (PR.xAxis + 31, YtwoJ%)-(XlessI% + 14 + ExtR, YtwoJ%), PR.CharClr, , R1%

LINE (PR.xAxis + 24, YtwoJ1%)-(XlessI% + 7, YtwoJ1%), PR.CharClr, , L1%

LINE (PR.xAxis + 32, YtwoJ1%)-(XlessI% + 14 + ExtR, YtwoJ1%), PR.CharClr, , R1%

END IF

RETURN

CalcXYparams:

XlessI% = PR.xAxis - Islant% 'Define PR.xAxis - Islant%

YtwoJ% = PR.yAxis + j% * Two% 'Define PR.yAxis + Two% * j%

YandJlessAd% = PR.yAxis + j% - adjust% 'Define PR.yAxis + j% - adjust%

x7% = PR.xAxis + 7 'Define PR.xAxis + 7

YtwoJ1% = YtwoJ% + one% 'Define YtwoJ% + one%

YtwoJ2% = YtwoJ% + 2 'Define YtwoJ% + 2

YtwoJ12% = YtwoJ1% + 2 'Define YtwoJ1% + 2

RETURN

END SUB

DEFINT A-Z

SUB SetBit (Value%, BitNumber%, BitOn%) STATIC

'**** Sets an individual bit (BitNumber%) on if BitOn% is true,

' otherwise if BitOn% is false then the bit is turned off.

IF BitOn THEN

Value = Value OR BitValue(BitNumber)

ELSEIF NOT BitNumber = 15 THEN 'Turn off bit 0 - 14

Value = Value AND 32767 - BitValue(BitNumber)

ELSE 'Turn off bit 15 - requires special handling

Value = Value AND -(BitValue(BitNumber) + 1)

END IF

END SUB

DEFINT A-Z

FUNCTION TestBit% (Value%, BitNumber%) STATIC

'**** Test whether a bit is turned on or off

TestBit = (Value AND BitValue(BitNumber)) = BitValue(BitNumber)

END FUNCTION

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

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

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/