$CPU 8086 ' make compatible with XT systems
$LIB ALL OFF ' turn off all PowerBASIC libraries
$ERROR ALL OFF ' turn off all PowerBASIC error checking
$OPTIMIZE SIZE ' optimize for smaller code
$COMPILE UNIT ' compile to a UNIT (.PBU)
'$COMPILE EXE ' compile to a UNIT (.PBU)
DEFINT A-Z ' Required for all numeric functions, forces PB to not
' include floating point in UNIT (makes it smaller)
'/*------------------------------------------------------------------*/
$CODE SEG "MLIB2"
'/*------------------------------------------------------------------*/
SUB SETHP(BYVAL OPT AS STRING) PUBLIC
OPT = UCASE$(OPT) + STRING$(5,32)
FI = INSTR(1,(OPT),"INIT")
FLAND = INSTR(1,(OPT),"LAND")
FPORT = INSTR(1,(OPT),"PORT")
FRPORT = INSTR(1,(OPT),"RPORT")
FRLAND = INSTR(1,(OPT),"RLAND")
FFF = INSTR(1,(OPT),"FF")
FBOLDON = INSTR(1,(OPT),"BOLDON")
FBOLDOFF = INSTR(1,(OPT),"BOLDOFF")
FITALICON = INSTR(1,(OPT),"ITALICON")
FITALICOFF = INSTR(1,(OPT),"ITALICOFF")
FSYM = INSTR(1,(OPT),"SYM")
F_NBR = INSTR(1,(OPT),"NBR")
FLPI = INSTR(1,(OPT),"LPI")
FPL = INSTR(1,(OPT),"PL")
FCPI = INSTR(1,(OPT),"CPI")
FTYPE = INSTR(1,(OPT),"TYPE")
FMLIB = INSTR(1,(OPT),"MLIB")
FSTYLE = INSTR(1,(OPT),"STYLE")
FFONTP = INSTR(1,(OPT),"FONTP")
'/* --- Form Feed? ---*/
IF FFF > 0 THEN LPRINT "&l0H"
'/* --- Reinit Printer? ---*/
IF FI > 0 THEN
L$ = CHR$(27) + "E"
LPRINT L$
END IF
'/* --- Number of Copies? ---*/
IF F_NBR > 0 THEN
T$ = MID$(OPT,F_NBR+3,2)
T$ = LTRIM$(RTRIM$(T$))
L$ = "&l" + T$ + "X"
LPRINT L$
END IF
'/* --- #PL ---*/
IF FPL > 0 THEN
T$ = MID$(OPT,FPL+2,2)
T$ = LTRIM$(RTRIM$(T$))
L$ = "&l" + T$ + "P"
LPRINT L$
END IF
'/* --- Orientation? ---*/
IF FLAND > 0 OR FPORT > 0 OR FRLAND > 0 OR FRPORT > 0 THEN
'/* --- Portrait? ---*/
IF FPORT > 0 THEN L$ = "&l0O"
'/* --- Landscape? ---*/
IF FLAND > 0 THEN L$ = "&l1O"
'/* --- Reverse Portrait? ---*/
IF FRPORT > 0 THEN L$ = "&l2O"
'/* --- Reverse Landscape? ---*/
IF FRLAND > 0 THEN L$ = "&l3O"
LPRINT L$
END IF
'/* --- LPI? ---*/
IF FLPI > 0 THEN
T$ = MID$(OPT,FLPI+3,2)
T$ = LTRIM$(RTRIM$(T$))
L$ = "&l" + T$ + "D"
LPRINT L$
END IF
'/* --- Symbol Set? ---*/
IF FSYM > 0 THEN
L$ = ""
SP = FSYM + 3
EP = INSTR(SP,OPT," ")
T$ = MID$(OPT,SP,EP-SP)
IF T$ = "1" THEN L$ = "(0D" :'/*ISO 60 Norwegian 1
IF T$ = "2" THEN L$ = "(1E" :'/*ISO 4 United Kingdom
IF T$ = "3" THEN L$ = "(9E" :'/*Windows 31 Latin 2
IF T$ = "4" THEN L$ = "(1F" :'/*ISO 69 French
IF T$ = "5" THEN L$ = "(1G" :'/*ISO 21 German
IF T$ = "6" THEN L$ = "(0I" :'/*ISO 15 Italian
IF T$ = "7" THEN L$ = "(6J" :'/*Microsoft Publishing
IF T$ = "8" THEN L$ = "(7J" :'/*DeskTop
IF T$ = "9" THEN L$ = "(10J" :'/*PS Text
IF T$ = "10" THEN L$ = "(12J" :'/*MC Text
IF T$ = "11" THEN L$ = "(13J" :'/*Ventura International
IF T$ = "12" THEN L$ = "(14J" :'/*Ventura US
IF T$ = "13" THEN L$ = "(579L" :'/*Wingdings
IF T$ = "14" THEN L$ = "(5M" :'/*PS Math
IF T$ = "15" THEN L$ = "(6M" :'/*Ventura Math
IF T$ = "16" THEN L$ = "(8M" :'/*Math 8
IF T$ = "17" THEN L$ = "(19M" :'/*Symbol
IF T$ = "18" THEN L$ = "(0N" :'/*ISO 8859-1 (ECMA-94) Latin 1
IF T$ = "19" THEN L$ = "(2N" :'/*ISO 8859-2 Latin 2
IF T$ = "20" THEN L$ = "(5N" :'/*ISO 8859-9 Latin 5
IF T$ = "21" THEN L$ = "(0S" :'/*Sweedish ISO 11
IF T$ = "22" THEN L$ = "(2S" :'/*Spanish ISO 17
IF T$ = "23" THEN L$ = "(5T" :'/*Windows 3.1 Latin 5
IF T$ = "24" THEN L$ = "(9T" :'/*PC Turkish
IF T$ = "25" THEN L$ = "(0U" :'/*ISO 6 ASCII
IF T$ = "26" THEN L$ = "(1U" :'/*Legal
IF T$ = "27" THEN L$ = "(8U" :'/*Roman8
IF T$ = "28" THEN L$ = "(9U" :'/*Windows 3.0 Latin 1
IF T$ = "29" THEN L$ = "(10U" :'/*PC-8 (Line characters)
IF T$ = "30" THEN L$ = "(11U" :'/*PC-8 D/N
IF T$ = "31" THEN L$ = "(12U" :'/*PC 850
IF T$ = "32" THEN L$ = "(15U" :'/*Pi Font
IF T$ = "33" THEN L$ = "(17U" :'/*PC-852
IF T$ = "34" THEN L$ = "(19U" :'/*Windows 3.1 Latin 1 (ANSI)
LPRINT L$
END IF
'/* --- CPI? ---*/
IF FCPI > 0 THEN
T$ = MID$(OPT,FCPI+3,2)
T$ = LTRIM$(RTRIM$(T$))
L$ = "(s" + T$ + ".00H"
LPRINT L$
END IF
'/* --- Style? ---*/
IF FSTYLE > 0 THEN
L$ = ""
SP = FSTYLE + 5
EP = INSTR(SP,OPT," ")
T$ = MID$(OPT,SP,EP-SP)
IF T$ = "0" THEN T$ = "0" :'/*Normal
IF T$ = "1" THEN T$ = "1" :'/*Italic
IF T$ = "2" THEN T$ = "4" :'/*Condensed
IF T$ = "3" THEN T$ = "5" :'/*Condensed Italic
IF T$ = "4" THEN T$ = "8" :'/*Extra Compressed
IF T$ = "5" THEN T$ = "24" :'/*Expanded
IF T$ = "6" THEN T$ = "64" :'/*Inline
IF T$ = "7" THEN T$ = "128" :'/*Shadowed
IF T$ = "8" THEN T$ = "160" :'/*Outline Shadowed
L$ = "(s" + T$ + "S"
LPRINT L$
END IF
'/* --- Type Face? ---*/
IF FTYPE > 0 THEN
L$ = ""
SP = FTYPE + 4
EP = INSTR(SP,OPT," ")
T$ = MID$(OPT,SP,EP-SP)
T$ = LTRIM$(RTRIM$(T$))
L$ = "(s" + T$ + "T"
LPRINT L$
END IF
'/* --- My Fonts?(MLIB) ---*/
IF FMLIB > 0 THEN
SP = FMLIB + 4
C$ = MID$(OPT,SP,1)
L$ = ""
SP = FMLIB + 5
EP = INSTR(SP,OPT," ")
T$ = MID$(OPT,SP,EP-SP)
IF C$ = "P" THEN
LL$ = "&l0O&l6D(s0p"
LM$ = T$
LR$ = ".00h12.00v0s3b3T"
L$ = "&l0O"
END IF
'/* --- Landscape? ---*/
IF C$ = "L" THEN
LL$ = "&l1O&l8D(s0p"
LM$ = T$
LR$ = ".00h12.00v0s3b3T"
L$ = "&l1O"
END IF
'/* --- Join Strings ---*/
L$ = LL$ + LM$ + LR$
LPRINT L$
END IF
'/* --- Italics? ---*/
IF FITALICON > 0 OR FITALICOFF > 0 THEN
IF FITALICON THEN L$ = "(s1S"
IF FITALICOFF THEN L$ = "(s0S"
LPRINT L$
END IF
END SUB
'/*--- Test CODE ----------------------------------------------------*/
' $INCLUDE "C:\CODE\MLIB\MLIB.INC"
' SETHP "INIT MLIBL17"
' SHELL "D C:\*.*"
' FOR ROW = 1 TO 25
' T$ = ""
' FOR COL = 1 TO 80
' T$ = T$ + CHR$(SCREEN(ROW,COL,0))
' NEXT COL
' LPRINT T$;
' NEXT ROW
' SETHP "FF"
' SETHP "BOLDON"
' SHELL "DIR C:\*.* /W"
' FOR ROW = 1 TO 25
' T$ = ""
' FOR COL = 1 TO 80
' T$ = T$ + CHR$(SCREEN(ROW,COL,0))
' NEXT COL
' LPRINT T$;
' NEXT ROW
' SETHP "FF"
' SETHP "PORT20"
' SETHP "ITALICON"
' SHELL "DIR C:\*.* /W"
' FOR ROW = 1 TO 25
' T$ = ""
' FOR COL = 1 TO 80
' T$ = T$ + CHR$(SCREEN(ROW,COL,0))
' NEXT COL
' LPRINT T$;
' NEXT ROW
' SETHP "FF"