Category : BASIC Source Code
Archive   : PRINTROM.ZIP
Filename : PRINTROM.BAS
Output of file : PRINTROM.BAS contained in archive : PRINTROM.ZIP
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/