home *** CD-ROM | disk | FTP | other *** search
- TYPE RegTypeX
- 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
-
-