Category : BASIC Source Code
Archive   : ALIB.ZIP
Filename : INIT-U.BAS
' ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
' º º
' º INIT_U.BAS º
' º º
' º HB's AP LIBRARY INITIALIZE º
' º º
' ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
$COMPILE UNIT
$ERROR ALL OFF
%False = 0
%True = NOT %False
DEFINT A-Z
EXTERNAL RD$, VideoSeg&, ColorDisplay, NeedDCon, CursorTop, CursorBottom
EXTERNAL OrigL, OrigC
EXTERNAL Up2B$, Esc2Q$, F1Help$, F2Fun$, EnHelp$
EXTERNAL InitPrt$, GraphicsChrSetOn$, GraphicsChrSetOff$, BoldPrtOn$
EXTERNAL BoldPrtOff$, ItalicPrtOn$, ItalicPrtOff$, RegPrt$, FastPrt$
EXTERNAL WidePrt$, BigPrtOn$, BigPrtOff$, LQPrt$, DraftPrt$
EXTERNAL MicroPrtOn$, MicroPrtOff$, ElitePrt$, PicaPrt$, ReverseLF$
DECLARE SUB SCREENPUSH ()
DECLARE FUNCTION GetYesOrNo ()
DECLARE FUNCTION IsRodent ()
DECLARE FUNCTION Cen$ (string)
' =========================================================================
SUB Initialize (PrinterType) PUBLIC
%Star10X = 1: %StarNX1000 = 2: %IBMX24 = 3: %LQ2500 = 4 ' Printer constants
LOCAL VideoSegError
Up2B$ = " ["+CHR$(24)+"] to back up "
Esc2Q$ = " [ESC] for Main Menu "
F1Help$ = " [F1] for Help "
F2Fun$ = " [F2] to SAVE or CLEAR data "
' EnHelp$ = " Keys: ["+CHR$(26)+"] & ["+CHR$(27)+"], [HOME]"+_
' " & [END], [INS] & [DELETE], ^T & ^Y. To go on: ["+CHR$(25)+"]"
EnHelp$ = Cen$ ("You can make an entry in this space now or press [" + _
CHR$(25)+"]" + " to go on.")
IF PrinterType = %Star10X THEN
' <<< PRINTER CODES FOR STAR GEMINI 10X >>>
InitPrt$ = CHR$(27) + "F" + CHR$(27) + "P" + CHR$(27) + "W0" + CHR$ (18)
BoldPrtOn$ = CHR$(27) + "G"
BoldPrtOff$ = CHR$(27) + "H"
MicroPrt$ = CHR$(27) + "F" + CHR$(15)
ElitePrt$ = CHR$(27)+"B"+CHR$(2)
ItalicPrtOn$ = CHR$(27) + "4"
ItalicPrtOff$ = CHR$(27) + "5"
RegPrt$ = CHR$(27) + "E"
FastPrt$ = CHR$(18) + CHR$(27) + "F"
WidePrt$ = CHR$(14)
ELSEIF PrinterType = %StarNX1000 THEN
' <<< PRINTER CODES FOR STAR NX - 1000 >>>
InitPrt$ = CHR$(27) + "F" + CHR$(27) + "P" + CHR$(27) + "W0" + CHR$ (18)
BoldPrtOn$ = CHR$(27) + "G"
BoldPrtOff$ = CHR$(27) + "H"
MicroPrt$ = CHR$(15)
ElitePrt$ = CHR$(27) + "M"
ItalicPrtOn$ = CHR$(27) + "4"
ItalicPrtOff$ = CHR$(27) + "5"
RegPrt$ = CHR$(27) + "E"
FastPrt$ = CHR$(18) + CHR$(27) + "F"
WidePrt$ = CHR$(14)
LQPrt$ = CHR$(27) + "x" + CHR$(1)
DraftPrt$ = CHR$(27) + "x" + CHR$(0)
ELSEIF PrinterType = %IBMX24 THEN
' <<< PRINTER CODES FOR PANASONIC KX-P1124 EMULATING PROPRINTER X24 >>>
InitPrt$ = CHR$(27) + "I" + CHR$(0) + CHR$(27) + "[@" + CHR$(4) + CHR$(0) + _
CHR$(0) + CHR$(0) + CHR$(17) + CHR$(1) + CHR$(27) + "F" + CHR$(27) + _
"H" + CHR$(18)
BoldPrtOn$ = CHR$(27) + "G"
BoldPrtOff$ = CHR$(27) + "H"
LQPrt$ = CHR$(27) + "I" + CHR$(2)
MicroPrt$ = CHR$(27)+"I"+CHR$(16)
MicroLQPrt$ = CHR$(27)+"I"+CHR$(18)
ElitePrt$ = CHR$(27) + "I" + CHR$(8)
EliteLQPrt$ = CHR$(27) + "I" + CHR$(10)
ItalicPrtOn$ = ""
ItalicPrtOff$ = ""
RegPrt$ = CHR$(27) + "E"
FastPrt$ = CHR$(18) + CHR$(27) + "F"
WidePrt$ = CHR$(14)
BigPrt$ = CHR$(27) + "[@" + CHR$(4) + CHR$(0) + CHR$(0) + CHR$(0) + _
CHR$(17) + CHR$(1) + CHR$(27) + "G"
ELSEIF PrinterType = %LQ2500 THEN
' <<< PRINTER CODES FOR PANASONIC KX-P1124 EMULATING LQ-2500 >>>
InitPrt$ = CHR$(27) + "@"
GraphicsChrSetOn$ = CHR$(27) + "t" + CHR$(1) + CHR$(27) + "6"
GraphicsChrSetOff$ = CHR$(27) + "t" + CHR$(0)
BoldPrtOn$ = CHR$(27) + "G"
BoldPrtOff$ = CHR$(27) + "H"
ItalicPrtOn$ = CHR$(27) + "4"
ItalicPrtOff$ = CHR$(27) + "5"
RegPrt$ = CHR$(27) + "E"
FastPrt$ = CHR$(18) + CHR$(27) + "F"
WidePrt$ = CHR$(14)
BigPrtOn$ = CHR$(27) + "w" + CHR$(1) + CHR$(27) + "W" + CHR$(1)
BigPrtOff$ = CHR$(27) + "w" + CHR$(0) + CHR$(27) + "W" + CHR$(0)
LQPrt$ = CHR$(27) + "x" + CHR$(1)
DraftPrt$ = CHR$(27) + "x" + CHR$(0)
MicroPrtOn$ = CHR$(15) ' 137 chr/ln
MicroPrtOff$ = CHR$(18)
ElitePrt$ = CHR$(27) + "M" ' 96 chr/ln
PicaPrt$ = CHR$(27) + "P"
ReverseLF$ = CHR$(27) + "j" + CHR$ (30)
END IF
' _________________________________________________________________________
' GetMonitorType
DEF SEG = &H40
IF PEEK(&H63)+256*PEEK(&H64)+6 = &H3BA THEN
ColorDisplay = %False ' I got this from a .ASM file by
ELSE ' Mike Mefford -- tho' I don't
ColorDisplay = %True ' speak ASM at all. I just took
END IF ' the address & byte to check
' for and it seems to work ...
' CheckVideoAddress
GOSUB SetVideoAddress
OrigL = CSRLIN: OrigC = CSRLIN
CALL SCREENPUSH ' save the screen prior to
GOSUB WriteAndPeek ' writing to it ...
IF VideoSegError THEN
COLOR 3,0: LOCATE 10,10
PRINT "ERROR READING MONITOR TYPE. IS THIS A COLOR MONITOR?";
ColorDisplay = GetYesOrNo
GOSUB SetVideoAddress
GOSUB WriteAndPeek
IF VideoSegError THEN
COLOR 3,0: LOCATE 12,10
PRINT "UNABLE TO SET ADDRESS OF DISPLAY CORRECTLY FOR THIS MACHINE"
LOCATE 14, 14: PRINT "SOME DEEP PROBLEM NEEDS CORRECTED. EXITING NOW."
STOP
END IF
END IF
NeedDCon = (IsRodent <> %False)
EXIT SUB
' ================================== end of subroutine HBInit
SetVideoAddress:
IF ColorDisplay THEN
VideoSeg& = &HB800: CursorTop = 6: CursorBottom = 7
ELSE
VideoSeg& = &HB000: CursorTop = 14: CursorBottom = 15
END IF
RETURN
WriteAndPeek:
COLOR 7,0: CLS
COLOR 0,0
PRINT "01234"
DEF SEG = VideoSeg&
FOR N = 0 TO 4
IF VAL(CHR$(PEEK(2*N))) <> N OR PEEK (2*N+1) <> 0 THEN
VideoSegError = %True
RETURN
END IF
NEXT
RETURN
END SUB
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/