Listing: 1 (******************************************************************************) 2 (* SAMPLE03.MOD *) 3 (* *) 4 (* SetFont Example *) 5 (* Taken from SAMPLE03.PAS - Metagraphics Software Corporation (c) 1987-1989 *) 6 (* *) 7 (* PSW 10/31/90 08:20pm *) 8 (******************************************************************************) 9 10 MODULE Sample03; 11 (* 12 * Graphix 13 * Release 3.7 14 * (c) Copyright 1986-1992 PMI 15 * Green Bay, Wisconsin 16 * (414) 468-6040 17 * All rights reserved 18 * 19 *) 20 21 IMPORT GrQry; 22 IMPORT GrConst; 23 IMPORT GrFonts; 24 IMPORT GrPorts; 25 IMPORT Meta; 26 IMPORT IO; 27 28 (* standard memory allocation procedures *) 29 FROM Storage IMPORT ALLOCATE, DEALLOCATE, Available; 30 31 VAR 32 GrafixCard, 33 CommPort: INTEGER; 34 i, loadErr: INTEGER; 35 font1Ptr, 36 font2Ptr, 37 font3Ptr, 38 original: GrFonts.adsFont; ***** ^ not supported yet 39 filename: ARRAY[0..128] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 40 scrnR: GrConst.rect; ***** ^ not supported yet 41 ch: CHAR; 42 scrnPort: GrPorts.adsPort; ***** ^ not supported yet 43 44 45 BEGIN 46 (* init the system *) 47 48 GrQry.GrInit(GrafixCard, CommPort); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 49 50 i := Meta.InitGrafix(-GrafixCard); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 51 52 IF (i # 0) THEN 53 (* Display reason for no go *) 54 GrQry.GrInitErr(GrafixCard, CommPort, i); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 55 END; 56 57 (* get original fonts buffer pointer *) 58 Meta.GetPort(scrnPort); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 59 original := scrnPort^.txFont; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 60 61 ALLOCATE(ADDRESS(font1Ptr), 3000); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 62 loadErr := Meta.FileLoad('SYSTEM08.FNT', ADDRESS(font1Ptr), 3000); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 63 IF (loadErr < 0) THEN 64 GrQry.GrQuit('FileLoad(SYSTEM08.FNT) Error.', 1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 65 END; 66 67 ALLOCATE(ADDRESS(font2Ptr), 3000); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 68 loadErr := Meta.FileLoad('SYSTEM16.FNT', ADDRESS(font2Ptr), 3000); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 69 IF (loadErr < 0) THEN 70 GrQry.GrQuit('FileLoad(SYSTEM16.FNT) Error.', 1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 71 END; 72 73 ALLOCATE(ADDRESS(font3Ptr), 4000); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 74 loadErr := Meta.FileLoad('ROMANSIM.FNT', ADDRESS(font3Ptr), 4000); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 75 IF (loadErr < 0) THEN 76 GrQry.GrQuit('FileLoad(ROMANSIM.FNT) Error.', 1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 77 END; 78 79 Meta.ScreenRect(scrnR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 80 Meta.SetDisplay(GrConst.GrafPg0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 81 Meta.EraseRect(scrnR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 82 Meta.TextSize(14, 14); (* Set text size for stroked font, ROMANSIM.FNT *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 83 Meta.TextFace(GrConst.cProportional); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 84 85 Meta.SetFont(ADDRESS(font1Ptr)); (* Set font 1 active *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 86 Meta.MoveTo(10, 130); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 87 Meta.DrawString('Text output using SYSTEM08.FNT'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 88 89 Meta.SetFont(ADDRESS(font2Ptr)); (* Set font 2 active *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 90 Meta.MoveTo(10, 150); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 91 Meta.DrawString('Text output using SYSTEM16.FNT'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 92 93 Meta.SetFont(ADDRESS(font3Ptr)); (* Set font 3 active *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 94 Meta.MoveTo(10, 170); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 95 Meta.DrawString('Text output using ROMANSIM.FNT'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 96 97 Meta.SetFont(ADDRESS(original)); (* Set original font active *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 98 Meta.MoveTo(10, 190); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 99 Meta.DrawString('Text output using original system font'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 100 101 Meta.MoveTo(10, 20); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 102 Meta.DrawString('Press return to terminate'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 103 ch := IO.RdChar(); (* Wait for a keypress *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 104 105 GrQry.GrQuit('', 0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 106 END Sample03. 131 errors