(* ***************************************************************** *) (* *) (* NewFonts.Pas Demo4 *) (* *) (* This program writes same screen as the previous one, except *) (* this version of it shows how to write a procedure that avoids *) (* having to call all the redesigned ascii fonts by NUMBER. The *) (* relevant procedure is called WriteString. Using WriteString, *) (* one simply types a statement similar in form to the Pascal write *) (* statement, however, WriteString takes two additional parameters *) (* which locate the cursor prior to writing the translated string. *) (* Following the first screen, a second screen of chemistry and *) (* math symbols is drawn. When using the procedure WriteString, *) (* no checks on the length of the string are made, it is up to *) (* the programmer to avoid writing beyond the edge of the screen. *) (* *) (* (c) Donald L. Pavia *) (* Department of Chemistry *) (* FONTDEMO4.PAS Western Washington Univ. *) (* Bellingham, WA. 98225 *) (* *) (* February 1986 *) (* *) (* ***************************************************************** *) program FontDemo4; {----------------------------------------------------------------------------} const FrameFonts : array[1..80] of byte = ( 127,64,95,81,93,69,125,1,223,80,87,85,93,65,127,0, 253,5,117,85,93,65,127,0,255,1,125,69,93,81,95,64, 127,64,95,81,93,69,125,1,127,1,125,69,93,81,95,64, 127,64,95,81,93,69,125,0,127,65,93,85,87,80,223,0, 127,65,93,85,117,5,253,0,127,1,125,69,93,81,223,0 ); {----------------------------------------------------------------------------} const ShadowFonts : array[1..208] of byte = ( 254,82,82,94,82,82,243,0,254,82,82,94,82,82,254,0, 254,162,160,160,160,162,254,0,254,82,82,82,82,82,254,0, 254,82,80,92,80,82,254,0,254,82,80,92,80,80,248,0, 254,162,160,174,162,162,254,0,243,82,82,94,82,82,243,0, 124,40,40,40,40,40,124,0,127,20,20,20,20,148,252,0, 243,82,86,92,94,82,243,0,248,80,80,80,82,86,254,0, 231,166,182,190,170,162,227,0,231,162,178,186,174,166,227,0, 254,162,162,162,162,162,254,0,254,82,82,94,80,80,248,0, 254,162,162,162,162,174,254,7,254,82,82,92,82,82,243,0, 254,162,160,254,10,138,254,0,254,170,40,40,40,40,124,0, 242,82,82,82,82,82,127,0,238,164,164,164,172,120,16,0, 227,170,170,190,182,162,227,0,198,106,52,40,88,172,198,0, 206,74,74,122,10,74,126,0,254,138,20,40,80,162,254,0 ); {----------------------------------------------------------------------------} const RomanFonts : array[1..208] of byte = ( 24,60,66,66,126,66,66,0,252,66,66,124,66,66,252,0, 60,66,64,64,64,66,60,0,252,66,66,66,66,66,252,0, 254,66,64,120,64,66,254,0,254,66,64,120,64,64,224,0, 60,66,64,78,66,66,60,0,66,66,66,126,66,66,66,0, 62,8,8,8,8,8,62,0,14,4,4,4,4,68,56,0, 198,68,72,112,72,68,198,0,224,64,64,64,66,70,254,0, 99,119,93,73,65,65,65,0,195,98,114,90,78,70,194,0, 60,66,66,66,66,66,60,0,252,66,66,124,64,64,240,0, 60,66,66,66,66,74,60,2,252,66,66,124,66,66,231,0, 126,66,64,126,2,66,126,0,254,146,16,16,16,16,56,0, 66,66,66,66,66,66,60,0,66,66,66,66,66,60,24,0, 65,65,65,73,93,119,99,0,66,66,36,24,24,36,66,0, 198,68,68,56,16,16,56,0,126,66,4,8,16,34,126,0 ); {----------------------------------------------------------------------------} const FatFonts : array[1..208] of byte = ( 16,56,108,108,254,238,238,0,252,246,246,252,246,246,252,0, 62,118,246,240,246,118,62,0,252,254,246,246,246,254,252,0, 254,254,240,252,240,254,254,0,254,254,240,252,240,240,240,0, 62,126,224,238,226,126,62,0,230,230,254,254,254,230,230,0, 60,60,60,60,60,60,60,0,30,30,30,222,222,254,124,0, 230,236,248,240,248,236,230,0,240,240,240,240,240,254,254,0, 226,246,234,226,226,226,226,0,230,230,246,254,238,230,230,0, 124,246,246,246,246,246,124,0,252,254,226,254,252,240,240,0, 124,246,246,246,246,246,126,3,252,254,226,254,252,246,243,0, 126,254,240,120,30,254,252,0,255,255,60,60,60,60,60,0, 238,238,238,238,238,254,124,0,238,238,108,124,56,56,16,0, 226,226,226,226,234,246,230,0,198,238,124,56,124,238,198,0, 198,238,124,56,56,56,56,0,254,254,252,24,62,126,254,0 ); {----------------------------------------------------------------------------} const SmallFonts : array[1..208] of byte = ( 0,56,68,124,68,68,0,0,0,124,68,124,68,124,0,0, 0,124,64,64,64,124,0,0,0,120,68,68,68,120,0,0, 0,124,64,120,64,124,0,0,0,124,64,120,64,64,0,0, 0,124,64,92,68,124,0,0,0,68,68,124,68,68,0,0, 0,56,16,16,16,56,0,0,0,4,4,4,68,124,0,0, 0,68,72,112,88,68,0,0,0,64,64,64,64,124,0,0, 0,66,102,90,66,66,0,0,0,68,100,84,76,68,0,0, 0,56,68,68,68,56,0,0,0,124,68,124,64,64,0,0, 0,56,68,68,84,60,4,0,0,124,68,120,76,68,0,0, 0,124,64,124,4,124,0,0,0,124,16,16,16,16,0,0, 0,68,68,68,68,56,0,0,0,68,68,40,16,16,0,0, 0,66,66,90,102,66,0,0,0,68,40,16,40,68,0,0, 0,68,40,16,16,16,0,0,0,124,8,16,32,124,0,0 ); {----------------------------------------------------------------------------} const ChemFonts : array[1..288] of byte = ( 0,0,0,0,0,0,255,255,8,4,254,0,254,64,32,0, 0,0,120,204,204,204,204,120,0,0,48,112,48,48,48,120, 0,0,120,204,24,96,192,252,0,0,120,204,24,12,204,120, 0,0,60,108,204,254,12,12,0,0,248,192,248,12,12,248, 0,0,120,128,248,204,204,120,0,0,248,24,48,48,96,96, 0,0,120,204,120,204,204,120,0,0,120,204,204,124,24,112, 96,144,144,144,96,0,0,0,32,96,32,32,32,0,0,0, 112,152,48,96,248,0,0,0,112,152,48,152,112,0,0,0, 48,80,144,248,16,0,0,0,240,128,224,16,224,0,0,0, 96,128,224,144,96,0,0,0,240,16,32,64,128,0,0,0, 96,144,96,144,96,0,0,0,96,144,112,16,96,0,0,0, 32,32,248,32,32,0,0,0,0,0,240,0,0,0,0,0, 0,0,0,60,6,62,102,59,0,0,96,32,60,38,38,92, 0,118,220,0,118,220,0,0,16,16,16,16,16,16,16,0, 72,72,72,72,72,72,72,0,252,0,0,252,0,0,252,0, 128,64,32,16,8,4,2,1,1,2,4,8,16,32,64,128, 0,0,0,204,204,0,0,0,255,255,0,0,0,0,0,0, 32,112,248,248,0,0,0,0,0,255,255,255,255,255,255,0 ); {----------------------------------------------------------------------------} procedure UseFrameFonts; begin memw[$0000:$007E] := seg(FrameFonts); memw[$0000:$007C] := ofs(FrameFonts); end; { procedure UseFrameFonts } {----------------------------------------------------------------------------} procedure UseShadowFonts; begin memw[$0000:$007E] := seg(ShadowFonts); memw[$0000:$007C] := ofs(ShadowFonts); end; { procedure UseShadowFonts } {----------------------------------------------------------------------------} procedure UseRomanFonts; begin memw[$0000:$007E] := seg(RomanFonts); memw[$0000:$007C] := ofs(RomanFonts); end; { procedure UseRomanFonts } {----------------------------------------------------------------------------} procedure UseFatFonts; begin memw[$0000:$007E] := seg(FatFonts); memw[$0000:$007C] := ofs(FatFonts); end; { procedure UseFatFonts } {----------------------------------------------------------------------------} procedure UseSmallFonts; begin memw[$0000:$007E] := seg(SmallFonts); memw[$0000:$007C] := ofs(SmallFonts); end; { procedure UseSmallFonts } {----------------------------------------------------------------------------} procedure UseChemFonts; begin memw[$0000:$007E] := seg(ChemFonts); memw[$0000:$007C] := ofs(ChemFonts); end; { procedure UseChemFonts } {----------------------------------------------------------------------------} type str80 = string[80]; var q : integer; Wait : char; {----------------------------------------------------------------------------} procedure WriteString (xpos,ypos : integer; Strg : str80); var i,Len : integer; Character : char; begin Len := Length (Strg); gotoxy (xpos,ypos); for i := 1 to Len do begin if Strg[i] in ['A'..'Z'] then Character := (chr (ord(Strg[i]) + 63)) else Character := Strg[i]; write (Character); end; end; { procedure WriteString } {----------------------------------------------------------------------------} procedure DrawFrameBorder; begin Draw (0,0,319,0,1); Draw (319,0,319,199,1); Draw (319,199,0,199,1); Draw (0,199,0,0,1); UseFrameFonts; TextColor (2); gotoxy (2,2); write (#128); for q := 3 to 19 do begin gotoxy (q,2); write (#129); end; for q := 20 to 38 do begin gotoxy (q,2); write (#130); end; gotoxy (39,2); write (#131); for q := 3 to 23 do begin gotoxy (2,q); write (#132); gotoxy (39,q); write (#133); end; gotoxy (2,24); write (#134); for q := 3 to 19 do begin gotoxy (q,24); write (#135); end; for q := 20 to 38 do begin gotoxy (q,24); write (#136); end; gotoxy (39,24); write (#137); end; { procedure DrawFrameBorder } {----------------------------------------------------------------------------} BEGIN clrscr; GraphColorMode; GraphBackGround (1); Palette (2); DrawFrameBorder; UseShadowFonts; TextColor (3); WriteString (15,6,'TURBO PASCAL'); UseRomanFonts; TextColor (1); WriteString (10,9,'GRAPHICS FONT DESIGNER'); UseFatFonts; TextColor (3); WriteString (11,12,'PROGRAMMER''S UTILITY'); { regular lo-ascii fonts } TextColor (1); gotoxy (13,16); write ('Donald L. Pavia'); UseSmallFonts; TextColor (3); WriteString (10,19,'DEPARTMENT OF CHEMISTRY'); WriteString (7,20,'WESTERN WASHINGTON UNIVERSITY'); WriteString (10,21,'BELLINGHAM WASHINGTON'); read (Kbd,Wait); {--------------------------------------------------------------} GraphColorMode; GraphBackGround (1); Palette (2); UseChemFonts; TextColor (1); gotoxy (5,5); write ('CH',#133,'CH',#132,'CO',#132,'H'); TextColor (2); gotoxy (20,5); write ('K',#152,' = 3.62 x 10',#151,#148); TextColor (3); gotoxy (14,9); write ('x',#142,' + y',#143,' = z',#145); TextColor (1); gotoxy (5,12); write ('CH',#133,'-CH-C',#157,'C-H'); gotoxy (5,13); write (' '#155); gotoxy (5,14); write (' CH',#133); TextColor (1); gotoxy (25,13); write (' ',#160); gotoxy (25,14); write (' Na',#150,' :Cl:',#151); gotoxy (25,15); write (' ',#160); TextColor (2); gotoxy (3,17); write (' ',#160); gotoxy (3,18); write (' O:'); gotoxy (3,19); write (' ',#156); gotoxy (3,20); write (' C '); gotoxy (3,21); write (' ',#159,' ',#158); gotoxy (3,22); write (' CH',#133,' CO',#132,'CH',#132,'CH',#133); TextColor (3); gotoxy (23,18); write (' CH',#133,' H'); gotoxy (23,19); write (' ',#158,' ',#159); gotoxy (23,20); write (' C=C '); gotoxy (23,21); write (' ',#159,' ',#158); gotoxy (23,22); write (' H CH',#133); read (Kbd,Wait); TextMode (c80); END.