'========================================================================= ' Personal Calendar (PC) Program ' Copyright (c) 1985-1990, Paul Munoz-Colman. All Rights Reserved. ' Version 14.10 ' 31 Oct 1990 ' Shareware $25 '========================================================================= ' DOS File CAL6.BAS ' Independently Compiled Subprograms Which Are Linked With CAL1.BAS '========================================================================= ' Written For IBM PCs & Compatibles Under MS DOS 3.30 on a Northgate 486 ' Compiled By Microsoft Professional BASIC 7.10, Linker Version 5.10 '========================================================================= ' Note -- Tabs in the source file are in positions 6,11,16,21,26,... '========================================================================= ' $INCLUDE: 'cal1.bi' '========================================================================= ' Subprogram List in the Order of Appearance in this File ' (compiled WITHOUT error handling--no /E or /X) '------------------------------------------------------------------------- ' Name Purpose ' --------------------------- --------------------------------------- ' SetDateTime Change DOS Date and Time ' SetOptions Write Options to Appointment File ' SetVideoMode (Why) Set User or Calendar Video Mode ' SetVideoPage (Why) Set Page Zero or User Page ' ShowErase (Kolor,ScreenRow,ScreenColumn,EraseFirst,ShowString$) ' Locate, Erase, and Display ' ShowIt (Kolor,ScreenRow,ScreenColumn,ShowString$) ' All Screen Displays ' ShowMult (Kolor,ScreenMultRow,ScreenColumn,EraseFirst, ' ScreenMultLines) ShowErase for Multiple Lines ' ShowOverduePage Display Excess Overdue Events ' Snooze (Secs!) Sleep for Seconds ' StayResInitialization Stay Res Plus Startup Code ' StayResKeyName Get English Hot Key Name ' StayResKeyShiftList For a Shift Code, Get Scan List Pointer ' StayResOptions (SrAutoOptions) Stay-Res Plus Options Menu/Check ' StayResPopDown (EntryPoint) Pop Down ' Fn Strng$ (RptTimes%, FillChar%) Replacement for STRING$ (MhString) ' Titles (NumberofLines) Generate Screen Titles (1 to 4 Lines) ' UnpackApptRecord Unpack Event Record to Fields ' UpdateClockScreen Change Date & Time On Clock Screen ' ValidateEventDate Check if Date Is Good ' VideoMonitorType Check Mono or Color ' WindowInit Initialize MhWind ' WindowRestore Restore User or Program Screen ' WindowSave Save User or Program Screen ' WriteCalauto Write Auto Startup CALAUTO.DAT File ' WriteCalDOS Write DOS Command CALDOS.DAT File ' WriteCalexcl Write Exclusion CALEXCL.DAT File ' WriteCalfig Write Color Choice CALFIG.DAT File ' WriteCalmusic Write CALMUSIC.DAT File ' WriteCalres Write CALRES.DAT File ' WritetoHistory Write Event to History (Check Exclusion) ' YearAdjust (YeartoAdjust,AdjustedYear$) ' Change Numeric Year To String Length 4 ' Fn ZeroFill$ (ToZeroFill$) All Blanks to Zeroes in String '========================================================================= SUB SetDateTime STATIC '========================================================================= ' Set DOS Date and Time DEFINT A-Z SubnumSave = Subnum Subnum = 116 '------------------------------------------------------------------------- CALL ClearScreenNormal(N1) CALL ShowErase(N7, N23, N62, N19, " Tab ") CALL ShowIt(N6, N0, Nm1, "Previous Item ") CALL ScreenBottoms ScreenTitles$(N1) = "Change DOS Date and/or Time" CALL Titles(N1) CALL ShowIt(N6, N12, N1, _ "Note: Changing the DOS date and time will change your computer's") CALL ShowIt(N0, Nm1, N0, _ " non-permanent CPU clock, and is effective until you reboot or") CALL ShowIt(N0, Nm1, N0, _ " power off.") CALL ShowIt(N0, N16, N0, _ " If your computer also has a permanent (battery-operated)") CALL ShowIt(N0, Nm1, N0, _ " clock/calendar, it will be updated only if CPU clock changes are") CALL ShowIt(N0, Nm1, N0, _ " monitored by your permanent clock's software or hardware.") MessageColumn = 37 '------------------------------------------------------------------------- FOR WhichType = N1 TO N2 ' 1 is Date and 2 is Time FOR WhichField = N1 TO N3 '--------------------------------------------------------------- ' Line 7 Date and 9 Time DateOrTime: SELECT CASE WhichType CASE 1 MessageText1$ = "Enter Date " BoxRow = N7 CASE 2 MessageText1$ = "Enter Time " BoxRow = N9 END SELECT MessageRow = BoxRow '--------------------------------------------------------------- BoxOffset = N3 * (WhichField - N1) 'Input Box Position BoxColumn = N25 + BoxOffset '--------------------------------------------------------------- SELECT CASE WhichType ' Prompts and Field Lengths CASE 1 DateTimeChange$ = DATE$ SELECT CASE WhichField CASE 1 MessageText2$ = "Day " HoldAtEnd = N0 Length = N2 CASE 2 MessageText2$ = "Month " Length = N2 CASE 3 MessageText2$ = "Year " Length = N4 END SELECT CASE 2 DateTimeChange$ = TIME$ SELECT CASE WhichField CASE 1 MessageText2$ = "Hour " Length = N2 CASE 2 MessageText2$ = "Minute" HoldAtEnd = N0 CASE 3 MessageText2$ = "Second" HoldAtEnd = N1 END SELECT END SELECT CALL ShowIt(N7, BoxRow, N25, DateTimeChange$) 'Current Value InputResponse$ = MID$(DateTimeChange$, N1 + BoxOffset, Length) CALL ControlledInput(BoxRow, BoxColumn, MessageRow, _ MessageColumn, Length, (MessageText1$ + MessageText2$), _ InputResponse$, N1, N1, N1, HoldAtEnd) ' Wants Out CALL BlankError IF RIGHT$(Keystroke$, N1) = CHR$(Esc) THEN GOTO DateTimeExit IF RIGHT$(Keystroke$, N1) = CHR$(Tabb) THEN ' Previous Field on Tab Key WhichField = WhichField - N1 IF WhichField = N0 THEN ' Previous Field Switches Types WhichField = N3 GOSUB ClearSpace IF WhichType = N1 THEN WhichType = N2 ELSE WhichType = N1 END IF END IF GOTO DateOrTime END IF '--------------------------------------------------------------- CALL Myd2(DateTimeChange$, N1 + BoxOffset, Length, _ InputResponse$) '--------------------------------------------------------------- ' Validate Date and Store if Good Date or Time ErrorSwitch = No CALL SetDateTimeGet (WhichType, DateTimeChange$) IF ErrorSwitch THEN ErrorSwitch = No MessageText$ = MID$(MessageText1$, N7, N4) + _ " Format or Range Is Unacceptable to DOS -- Try Again" CALL PrepareforMessage CALL ShowIt(N0, N0, N0, MessageText$) GOTO DateOrTime ' Try Again if Bad END IF '--------------------------------------------------------------- NEXT WhichField '-------------------------------------------------------------------- GOSUB ClearSpace 'Blank Out Prompt NEXT WhichType '------------------------------------------------------------------------- ' Finished DateTimeExit: CALL ClearScreenNormal(N1) CALL DirectReturnCheck Subnum = SubnumSave EXIT SUB '------------------------------------------------------------------------- ClearSpace: CALL ShowIt(N0, BoxRow, MessageColumn, SPACE$(N16)) RETURN END SUB '========================================================================= SUB SetOptions STATIC '========================================================================= ' Set Option Record From Individual Variables DEFINT A-Z SubnumSave = Subnum Subnum = 77 ' Set Options ApptMasterRec$ = Blank80$ CALL Myd2(ApptMasterRec$, N1, N8, ApptPassword$) ' Pos 1-8 Password CALL Myd2(ApptMasterRec$, N9, N1, (RIGHT$(STR$(FooterSize), N1))) ' Pos 9 Footer Size CALL Myd2(ApptMasterRec$, N10, N1, (RIGHT$(STR$(SoundLevel), N1))) ' Pos 10 Alarm Initial Condition CALL Myd2(ApptMasterRec$, N11, N1, (RIGHT$(STR$(NoteSize), N1))) ' Pos 11 Size Of Note Area On Footer IF InclHistory THEN IncludeHistory$ = True$ ELSE IncludeHistory$ = False$ CALL Myd2(ApptMasterRec$, N13, N1, IncludeHistory$) ' Pos 13 Print,Copy History IF InclNotes THEN IncludeNotes$ = True$ ELSE IncludeNotes$ = False$ CALL Myd2(ApptMasterRec$, N14, N1, IncludeNotes$) ' Pos 14 Print,Copy Notes CALL Myd2(ApptMasterRec$, N15, N1, WeekendScheduling$) ' Pos 15 Allow Weekends On Daily CALL Myd2(ApptMasterRec$, N16, N1, EventSizeCode$) ' Pos 16 60 Events "e" CALL Myd2(ApptMasterRec$, N17, N2, (RIGHT$(STR$(Pending), N2))) ' Pos 17-18 Event Look-Ahead in Minutes CALL Myd2(ApptMasterRec$, N19, N1, SelectedPrinter$) ' Pos 19 Selected Printer Code or "-" for disable CALL Myd2(ApptMasterRec$, N20, N1, WeekBreak$) ' Pos 20 Week Break on ASCII File or Print CALL Myd2(ApptMasterRec$, N21, N1, NoteSizeCode$) ' Pos 21 60 Notes "e" CALL Myd2(ApptMasterRec$, N22, N2, (RIGHT$(STR$(PrinterLineLimit), N2))) ' Pos 22-23 Printer Line Limit for Paging (0 means no paging) CALL Myd2(ApptMasterRec$, N24, N1, PrinterPause$) ' Pos 24 PrinterPause$ DO ' No Hex 0's in Master Record! J = InString(ApptMasterRec$, CHR$(N0)) IF J THEN CALL Myd2(ApptMasterRec$, J, N1, Blank1$) LOOP UNTIL J = N0 CALL MhLset(ApptBuffer$, ApptMasterRec$) CALL PutApptRecord(N1) Subnum = SubnumSave END SUB '========================================================================= SUB SetVideoMode (Why) STATIC '========================================================================= DEFINT A-Z SubnumSave = Subnum Subnum = 51 IF Why THEN ' Determine whether calendar or user mode AL% = UserMode ' Set user program mode ELSE IF UserMode = N2 THEN ' Set calendar mode unless user CalMode = N2 ELSEIF ColorCRT THEN CalMode = N3 ELSE CalMode = N7 END IF AL% = CalMode ' mode is 2 END IF ' Note that even though the current video mode is saved here, coming ' back from DOS can change the value of CurrentVideoMode, which is ' also tested and set in SaveDOSKeyState IF AL% <> CurrentVideoMode THEN ' If the requested mode is different CALL SrSetVideoMode(AL%) ' change it using Stay-Res CurrentVideoMode = AL% ' and save the result END IF IF Why THEN ' Change lines per screen IF UserColumns = N80 THEN ' If user display had 80 columns SELECT CASE UserRows ' see if 43 or 50 line mode indicated CASE N25 ' 25-line mode IF DisplayRows <> N25 OR DisplayColumns <> N80 THEN CALL Mh80x25 DisplayRows = N25 END IF CASE N43 ' 43-line (EGA) mode IF DisplayRows <> N43 OR DisplayColumns <> N80 THEN CALL Mh80x43(Ecode43%) IF Ecode43 = N0 THEN DisplayRows = N43 END IF CASE N50 ' 50-line (VGA) mode IF DisplayRows <> N50 OR DisplayColumns <> N80 THEN CALL Mh80x50(Ecode50%) IF Ecode50 = 0 THEN DisplayRows = 50 END IF END SELECT END IF ELSE ' Restore screen lines if necessary IF DisplayRows <> N25 OR DisplayColumns <> N80 THEN CALL Mh80x25 DisplayRows = N25 DisplayColumns = N80 END IF END IF Subnum = SubnumSave END SUB '========================================================================= SUB SetVideoPage (Why) STATIC '========================================================================= DEFINT A-Z SubnumSave = Subnum Subnum = 137 InterruptNumber% = &H10 ' ROM-BIOS Video Services Interrupt AH% = &H05 ' Set Video Page IF Why THEN AL% = DOSCursorPage ELSE AL% = ScreenPage END IF IF AL% <> CurrentVideoPage THEN CurrentVideoPage = AL% CALL DOSBIOSServices END IF Subnum = SubnumSave END SUB '========================================================================= SUB ShowErase (EKolor, EScreenRow, EScreenColumn, _ EraseFirst, ShowString$) STATIC '========================================================================= DEFINT A-Z SubnumSave = Subnum Subnum = 78 ScreenColumn = EScreenColumn ScreenRow = EScreenRow Kolor = EKolor CALL ShowIt(Kolor, ScreenRow, ScreenColumn, (SPACE$(EraseFirst))) CALL ShowIt(Kolor, ScreenRow, ScreenColumn, ShowString$) Subnum = SubnumSave END SUB '========================================================================= SUB ShowIt (IKolor, ShowRow, ShowColumn, ShowString$) STATIC '========================================================================= ' Single Place to Call MhScr to Display Stuff On Screen (easier call) DEFINT A-Z SubnumSave = Subnum Subnum = 79 ' Use pre-existing screenrow and screencolumn if input is zero ' ScreenPage and ColorAttribute already set and in Common ' Kolor non zero means change color requested Kolor = IKolor IF Kolor THEN CALL Kolors(Kolor) ' Set Color if Asked For SELECT CASE ShowRow CASE IS < N0 ' Increment n rows, Same Column ScreenRow = ScreenRow + ABS(ShowRow) CASE 0 ' Screen Row Remains Unchanged CASE ELSE ' Screen Row Is Input Value ScreenRow = ShowRow END SELECT SELECT CASE ShowColumn CASE Nm2 ' Line Automatically Centered L-to-R ToCenter = LEN(ShowString$) IF ToCenter MOD 2 = 1 THEN ToCenter = ToCenter + 1 END IF ScreenColumn = (N80 - ToCenter) \ N2 CASE Nm1 ' Screen Column Bumped By Previous ScreenColumn = ScreenColumn + PreviousLength CASE 0 ' Screen Column Remains Unchanged CASE ELSE ' Screen Column Is Input Value ScreenColumn = ShowColumn END SELECT CALL MhScr(ShowString$, ScreenPage%, ScreenRow%, ScreenColumn%, _ ColorAttribute%) PreviousLength = LEN(ShowString$) ' Save Length for Future -1 Call Subnum = SubnumSave END SUB '========================================================================= SUB ShowMult (MKolor, ScreenMultRow, MScreenColumn, EraseFirst, _ ScreenMultLines) STATIC '========================================================================= ' ShowErase for Multiple Lines ' Starting Row,Column,EraseFirst,Number of Lines DEFINT A-Z SubnumSave = Subnum Subnum = 80 Kolor = MKolor ScreenColumn = MScreenColumn FOR ZJ = N1 TO ScreenMultLines AtRow = ScreenMultRow + ZJ - N1 AtColumn = ScreenColumn AtErase = EraseFirst CALL ShowErase(Kolor, AtRow, AtColumn, AtErase, Blank0$) NEXT ZJ ScreenRow = ScreenMultRow Subnum = SubnumSave END SUB '========================================================================= SUB ShowOverduePage STATIC '========================================================================= DEFINT A-Z SubnumSave = Subnum Subnum = 81 CALL ClearScreenNormal(N0) OnOverduePage = Yes IF SoundLevel > N2 THEN CALL PlayAlarmWarning(N0) ScreenSize = N20 ClockScreen = No OnEditPage = No IF NOT FileExist(ApptFilenameOverdue$) THEN ' If called erroneously, exit OverdueCount = N0 GOTO ExitPoint0 END IF OPEN "R", FilenumOverdue, ApptFilenameOverdue$, N80 FIELD FilenumOverdue, N80 AS OverdueBuffer$ LastRecord = LOF(FilenumOverdue) \ N80 'Last Record Number LastPage = N1 + ((LastRecord - N1) \ ScreenSize)'Last Page CurrentPage = N1 ' Start New Page NewOverduePage: CALL ClearScreenNormal(N0) CALL KeyStuff(KeyStatusAbs) CurrentRecord = N1 + (CurrentPage - N1) * ScreenSize '--------------------------------------------------------------- ' Refresh Headers and Trailers ScreenTitles$(N1) = STR$(OverdueCount) + " EVENTS ARE OVERDUE!" CALL Titles(N1) CALL PopLine CALL QuitLine IF CurrentRecord > ScreenSize THEN CALL ShowIt(N7, N24, N1, "PgUp") CALL ShowIt(N6, N0, Nm1, " Previous Page") CALL ShowIt(N7, N0, N27, "Home") CALL ShowIt(N6, N0, Nm1, " 1st Page") END IF IF CurrentPage < LastPage THEN CALL ShowIt(N7, N25, N1, "PgDn") CALL ShowIt(N6, N0, Nm1, " Next Page") CALL ShowIt(N7, N0, N27, "End") CALL ShowIt(N6, N0, Nm1, " Last Page") END IF CALL ShowIt(N7, N25, N43, " Return,Esc ") CALL ShowIt(N6, N0, Nm1, "Clock") ' Get Next Record GetOverdueRecord: GET FilenumOverdue, CurrentRecord ' Set Screen Position ScreenPosition = N3 + (CurrentRecord - N1) MOD ScreenSize CALL ShowIt(N0, ScreenPosition, N1, OverdueBuffer$) ' End File or End Page IF CurrentRecord < LastRecord AND _ (CurrentRecord MOD ScreenSize) <> N0 THEN CurrentRecord = CurrentRecord + N1 GOTO GetOverdueRecord END IF NextOverdueKey: CALL KeyStuff(KeyWait) ' Wait for a keystroke SELECT CASE LEN(Keystroke$) CASE 1 ' Length 1 Keys (Esc,Prnt) SELECT CASE InString(CHR$(Enter) + CHR$(Esc), Keystroke$) CASE 1,2 ' Enter or Esc ' Resume Clock Exit RedisplayCalendars = Yes CALL ClearOverdueTable CASE ELSE 'Other Length 1 Keys (also Length 2) GOTO BadOverdueKey END SELECT GOTO ExitPoint0 CASE 2 ' Length 2 Keys ' Length 2 keys -- Next,Prev,First,Last,SpecificPage SELECT CASE InString(CHR$(PgUp) + CHR$(PgDn) + CHR$(HomeKey) + _ CHR$(EndKey), RIGHT$(Keystroke$, N1)) CASE 1, 3 ' PgUp or Home IF CurrentPage <= N1 THEN GOTO BadOverdueKey ' Pg Up or Home IF RIGHT$(Keystroke$, N1) = CHR$(PgUp) THEN CurrentPage = CurrentPage - N1 'PgUp ELSE CurrentPage = N1 'Home END IF GOTO NewOverduePage CASE 2, N4 ' PgDn or End IF CurrentPage >= LastPage THEN GOTO BadOverdueKey IF RIGHT$(Keystroke$, N1) = CHR$(PgDn) THEN CurrentPage = CurrentPage + N1 'PgDn ELSE CurrentPage = LastPage 'End END IF GOTO NewOverduePage CASE ELSE BadOverdueKey: CALL MinorBeeper GOTO NextOverdueKey END SELECT END SELECT ExitPoint0: OnOverduePage = No Subnum = SubnumSave END SUB '========================================================================= SUB Snooze (Secs!) STATIC '========================================================================= DEFINT A-Z SubnumSave = Subnum Subnum = 62 SnoozeSave! = TIMER ' Save Timer Value DO ' Loop IF NOT HardSnooze THEN CALL KeyStuff(KeySingle) ' May interrupt END IF SnoozeOver! = TIMER ' Save Current Timer IF SnoozeOver! < SnoozeSave! THEN ' Over Midnight? SnoozeSave! = SnoozeSave! - 86400! ' Yes-adjust END IF ' by one day IF (SnoozeOver! - SnoozeSave!) > Secs! OR _ ' Until Keypress or LEN(Keystroke$) THEN ' If not done EXIT DO END IF LOOP ExitPoint: Subnum = SubnumSave ' Else Exit END SUB '========================================================================= 'Stay-Res Plus 4.00 Order of CALL Precedence -- '-------------------------------------------------------------------- 'The following BASIC code shows the order in which calls should (and 'should not) be made to Stay-Res Plus routines. Note that it is not 'necessary to CALL all the routines shown. '-------------------------------------------------------------------- 'The following routines can be CALLed at any time '-------------------------------------------------------------------- 'CALL SrAutoScreenSave (Filename$, Ecode%) 'CALL SrDontRestoreScreen 'CALL SrDoRestoreGInfo 'CALL SrGetPokeAddress(Dtaseg%, Offset%) 'CALL SrMousePopUp(MButton%, MTopRow%, MLeftCol%, MBotRow%, MRightCol%) 'CALLS SrMultiKeys(ScanCode%(x), ShiftStatus%(x), HowManyKeys%) 'CALL SrNoSnow 'CALL SrResetHotkey(Kscan%, Kshift%) 'CALL SrSetBusyWait(Ticks%) 'CALL SrSetCom(Port%, Ecode%) 'CALL SrSetInt5 'CALL SrSetKBIdleTicks(Ticks%) 'CALL SrSetPokeChar(Ascii%) 'CALL SrSetQBPopUp 'CALL SrSetTimeY(Month%, Day%, Year%, Hour%, Minute%) 'CALL SrSetVideoMode(Mode%) 'CALL SrSoundOnBreak 'CALL SrTickPopUp(Ticks%) 'CALL SrUseAnyKey 'CALL SrUseComStatus(Port%, PortAddress%, TickDelay%, StatusMask%, Ecode%) 'CALL SrUseCtrlAltDel 'CALL SrUseErrorTable 'CALL SrUseSysReq 'CALL SrWaitAfter255 '-------------------------------------------------------------------- 'The following routines must be CALLed prior to CALLing any of ' SrCheckEms, SrSetDiskSwap and SrPopDown. '-------------------------------------------------------------------- 'CALL SrCancelForceFile0 'CALL SrForceFile0 'CALL SrSetDosMem(Bytes&) 'CALL SrSetUserMem(Bytes&) '-------------------------------------------------------------------- 'The following routines can be CALLed anytime before CALLing SrPopDown 'the first time '-------------------------------------------------------------------- 'CALL SrSetId(IDName$, IDNumber%, Ecode%) 'CALL SrUnInstall(Ecode%) 'CALL SrUseInterrupt (PopUpInterrupt%, ProcessInterrupt%, Ecode%) '-------------------------------------------------------------------- 'The following routines should be CALLed only after CALLing the 'counterpart routines. However, they can be CALLed before or after 'becoming memory-resident. '-------------------------------------------------------------------- 'CALL SrCancelAutoScreenSave 'CALL SrCancelQBPopUp 'CALL SrCancelUseAnyKey 'CALL SrCancelUseCtrlAltDel 'CALL SrCancelUseInterrupt 'CALL SrCancelUseSysReq 'CALL SrCancelWaitAfter255 'CALL SrDoRestoreScreen 'CALL SrDontRestoreGInfo 'CALL SrReleaseInt5 'CALL SrReleaseTimeY '-------------------------------------------------------------------- 'The following routines should be CALLed immediately before CALLing 'SrPopDown the first time '-------------------------------------------------------------------- 'CALL SrCheckEMS(Ecode%) 'CALL SrSetDiskSwap(FileName$, Ecode%) '-------------------------------------------------------------------- 'This is where you CALL SrPopDown '-------------------------------------------------------------------- 'CALL SrPopDown(Kscan%, Kshift%, Ecode%) '-------------------------------------------------------------------- 'CALLing the following routines is meaningful only after your program 'has become memory-resident and has successfully popped up '-------------------------------------------------------------------- 'CALL SrCancelMacro 'CALL SrCancelShell 'CALL SrFetchAnyKey(AAscii%, AScan%, Shift1%, Shift2%) 'CALL SrFetchRegisters(UserType) 'CALL SrGetCursorInfo(Page%, Row%, Column%, StartLine%, EndLine%) 'CALL SrGetEnvironment(Dtaseg%) 'CALL SrGetErrorLevel(Elevel%) 'Result$ = SrGetProgramName$ 'Result% = SrOverDos% 'Result% = SrScreenSaved% 'CALL SrReleaseMem(Ecode%) 'CALL SrResidentBatch(CmndLine$, Ecode%) 'CALL SrResidentShell(CmndLine$, Ecode%) 'CALL SrRestoreScreen 'CALL SrSetMacro(Macro$, Shift$) 'CALL SrSetRegisters(UserType) '========================================================================= SUB StayResInitialization (EntryPoint) STATIC '========================================================================= DEFINT A-Z SubnumSave = Subnum Subnum = 118 '========================================================================= ' This initialization code is executed only once, at the beginning ' of program initialization. See MainSub at the beginning for the ' calls to these entry points. '========================================================================= SELECT CASE EntryPoint '-------------------------------------------------------------------- CASE 0 '----------------------------------------------------------- ' Check/set Program's ID. If There, Exit SrMhIDName$ = "CAL" ' Stay-Res ID Name for This Program ' MicroHelp-Assigned Stay-Res ID Number For This Program SrMhIDNumber% = 1006 CALL SrSetId(SrMhIDName$, SrMhIDNumber%, Ecode%) '----------------------------------------------------------- IF Ecode% THEN ' Program already in memory. Pop up old copy and terminate. ' This pops up on ASCII 254 IF NOT FileExist("calpopup.com") THEN 'If no calpopup OPEN "R", #N1, "calpopup.com", N12 'file, then create FIELD #N1, N12 AS CalPopupString$ 'one 12-byte rec LSET CalPopupString$ = "3ÀŽØ¸þþ£Í "'using same con- PUT #N1, N1 'tents of original CLOSE #N1 'file END IF ' (if SRPOKER.COM Changes, this changes) RUN "calpopup.com" 'and pop up old copy '=================================================== ' Program Terminates Here To Pop Up In-Memory Copy ! '=================================================== END IF '----------------------------------------------------------- DIM WindowBuffer(2004) 'DIM Dynamic MhWind Buffer Array '----------------------------------------------------------- CASE 1 '----------------------------------------------------------- ' Set Stay-Res Plus Options ' to defaults, overridden by CALRES.DAT file '----------------------------------------------------------- UseEMS$ = True$ ' Allow EMS Usage (default) UseDiskSwap$ = True$ ' Allow Disk Swapping '----------------------------------------------------------- CALL ReadCalres '----------------------------------------------------------- ' File CALRES.DAT is read at this point, which sets 'AllowPopDateTime ' Whether date/time popup allowed 'EverResident$ ' Whether user ever used TSR mode 'SrAutoPopDown ' Whether auto pop down allowed 'SrDiskSwapping ' Whether disk swapping allowed 'SrDontUseEMS ' Whether EMS use not allowed 'SrKscanHot ' Hot key scan code 'SrKshiftHot ' Hot key shift code 'SrOptionsChosen ' Whether opts menu needs calling 'SrSnowCheck ' Whether CGA snow checking needed 'SrSwapPath$ ' Disk swap/screen save drive/path 'SrHotKeyName$ ' English name of hot key 'UseDiskSwap$ ' Whether disk swapping allowed 'UseEMS$ ' Whether EMS swapping allowed 'UserPopDateTime$ ' Whether date/time popup allowed '----------------------------------------------------------- SrAutoPopDownReady = No ' Auto pop down not ready SrAutoPopDownHappened = No ' Auto pop down hasn't happened SrDiskSwapped = No ' Set Disk Swapping Not Occurred SrEMS = No ' Initialize EMS Available Flag SrPopDateTime = No ' Disable Pop Up on Date/Time SrSetUserMemCalled = No ' SETMEM hasn't been called '----------------------------------------------------------- ' Delete old swap files if they are there ' Establish path followed by "\" for later use IF RIGHT$(SrSwapPath$, N1) <> "\" THEN SrSwapPathAdjusted$ = SrSwapPath$ + "\" ELSE SrSwapPathAdjusted$ = SrSwapPath$ END IF CALL KillAFile(SrSwapPathAdjusted$ + "calswap.000") CALL KillAFile(SrSwapPathAdjusted$ + "calswap.001") '----------------------------------------------------------- ' Delete old screen files and establish pointer to new one EgaFilename$ = "CALSCRN.DAT" ' Screen Save File Name (ASCIIN) EgaFilename2$ = ASCIIZ$(EgaFilename$) ' (ASCIIZ) EgaFilePath$ = SrSwapPathAdjusted$ + EgaFilename$ EgaFilePath2$ = ASCIIZ$(EgaFilePath$) CALL KillAFile(EgaFilename$) ' Kill Screen File if There '----------------------------------------------------------- CALL SrSetCom(N0, Ecode%) 'No comm pop up SrPokeCharCode% = 254 ' Wake up on dual 254's CALL SrSetPokeChar(SrPokeCharCode%) CALL SrUseErrorTable 'Extended DOS Busy Error Codes '----------------------------------------------------------- END SELECT Subnum = SubnumSave END SUB '========================================================================= SUB StayResKeyName STATIC '========================================================================= ' Get Hot Key Name and Set List Switches ' Input is SrKshiftHot and SrKscanHot ' Output is Scan Code List Pointer, English Name ' (SrScanChoice) (SrHotKeyName$) DEFINT A-Z SubnumSave = Subnum Subnum = 82 CALL StayResKeyShiftList ' Get Scan Code List Pointer IF SrKscanHot THEN FOR I = N1 TO NumberofHotFKeys IF FunctionScanCodes(SrWhichFList, I) = SrKscanHot THEN SrScanChoice = I EXIT FOR END IF NEXT I ELSE SrScanChoice = N0 END IF ' Don't use Control Key Names unless using some of the keys(!) SrHotKeyName$ = Blank0$ IF SrKshiftHot THEN SrHotKeyName$ = HotKeyNames$(SrKshiftHot + N1) IF SrKshiftHot > N0 AND SrScanChoice > N0 THEN SrHotKeyName$ = SrHotKeyName$ + " and " END IF IF SrScanChoice > N0 THEN SrHotKeyName$ = SrHotKeyName$ + "F" + LTRIM$(STR$(SrScanChoice)) END IF Subnum = SubnumSave END SUB '========================================================================= SUB StayResKeyShiftList STATIC '========================================================================= ' Get Which Shift List a Shift Key Is In ' Input is Shift Code (SrKshiftHot), Output is Which List (SrWhichFList) DEFINT A-Z SubnumSave = Subnum Subnum = 83 SELECT CASE SrKshiftHot CASE 0 ' Not Shift/Ctrl/Alt SrWhichFList = N1 CASE 1 TO 3 ' Either Shift SrWhichFList = N2 CASE N4 TO 7 ' Ctrl (& Shift) SrWhichFList = N3 CASE N8 TO N15 ' Alt (& Ctrl & Shift) SrWhichFList = N4 END SELECT Subnum = SubnumSave END SUB '========================================================================= SUB StayResOptions (OSrAutoOptions) STATIC '========================================================================= ' Set Memory Resident Options From File or From Menu DEFINT A-Z SubnumSave = Subnum Subnum = 84 SrAutoOptions = OSrAutoOptions NoKeyChoice = No SnowReset = No IF SrAutoOptions THEN ' If called on 1st pop down then NewGuyHold = NewGuy ' save all return switches NewGuy = Yes ' and set them accordingly StartupScreenHold = StartupScreen ' to avoid reflexive popping StartupScreen = No ' problems. (This is called ClockScreenHold = ClockScreen ' from StayResPopDown which is OnEditPageHold = OnEditPage ' called from KeyStuff. KeyStuff ClockScreen = No ' is also used by the routines OnEditPage = No ' this sub uses, which could InHelpHold = InHelp ' get into a deadly embrace. InHelp = No TimerDisplaySuppressHold = TimerDisplaySuppress CursorStateHold = CursorState CursorState = N0 END IF ValidSwapPath$ = SrSwapPath$ ' Save In Case User Messes It Up '-------------------------------------------------------------------- ' Options Haven't Been Set or Menu was Called to Set Them MemResOptionsMenu: CALL ClearScreenNormal(N1) ScreenTitles$(N1) = "Memory-Resident (TSR Mode) Options" ScreenTitles$(N2) = "(Please Consult Help Text For Explanation)" CALL Titles(Nm2) IF NOT SrOptionsChosen THEN SrOptionsChosen = Yes EverResident$ = True$ CALL PrepareforMessage CALL MajorBeeper CALL ShowIt(N0, N0, N0, _ "PC Has Never Been in TSR Mode in this Directory--Options Are As Follows") ELSEIF SnowReset THEN SnowReset = No CALL PrepareforMessage CALL ShowIt(N0, N0, N0, _ "Disk Swap/Screen Save File Path is Longer than 65 Bytes--Try Again") END IF CALL StayResKeyName MenuLines(N1) = "Hot Key for Pop Up, Currently " + SrHotKeyName$ IF AllowPopDateTime OR AllowPopDateTimeSave THEN ScreenTag$ = Yess$ ELSE ScreenTag$ = Noo$ END IF MenuLines(N2) = "Automatic Pop Up on Date/Time, Currently " + ScreenTag$ IF SrAutoPopDown THEN ScreenTag$ = Yess$ ELSE ScreenTag$ = Noo$ MenuLines(N3) = _ "Automatic Pop Down after Automatic Startup, Currently " + ScreenTag$ IF UseEMS$ = True$ THEN ScreenTag$ = Yess$ ELSE ScreenTag$ = Noo$ MenuLines(N4) = "Expanded (EMS) Memory for Program & Screens When " + _ "Popped Down, Currently " + ScreenTag$ IF UseDiskSwap$ = True$ THEN ScreenTag$ = Yess$ ELSE ScreenTag$ = Noo$ MenuLines(N5) = _ "Disk Swapping for Program & Screens When Popped Down, Currently " + ScreenTag$ MenuLines(N6) = "Disk Swap To " + SrSwapPath$ IF SrSnowCheck = Yes THEN ScreenTag$ = Yess$ ELSE ScreenTag$ = Noo$ MenuLines(N7) = _ "Snow Checking State for CGA Monitors, Currently " + ScreenTag$ IF SrPopupOnlyIfScreenSaved THEN ScreenTag$ = Noo$ ELSE ScreenTag$ = Yess$ MenuLines(N8) = _ "Avoid Pop Up if Unable to Save Non-Standard Video Screen, Currently " + _ ScreenTag$ '-------------------------------------------------------------------- ' Options Menu Choice CALL ShowIt(N6, N19, N1, _ ("- Hot Key, Automatic Pop Up/Pop Down, Snow Check " + _ "Changes Take Effect Immediately")) CALL ShowIt(N0, Nm1, N0, _ "- If EMS Memory and Disk Swapping Are Both Chosen, EMS Is Attempted First") CALL ShowIt(N0, Nm1, N0, _ ("- Disk Swapping/Screen Save Can Be Used With" + _ " A Virtual Disk (RAMDISK or VDISK)")) IF MemoryResident THEN CALL ShowIt(N0, Nm1, N0, _ "- Disk or EMS Swapping Changes Are Not In Effect Until PC is Restarted") END IF MenuSize = N8 MenuRow = N6 CALL WriteCalres ' Save the Results 1st! CALL MenuDriver(MenuSize, MenuSrOpt, MenuRow, Nm1, No, N0, N1, N1) IF MenuExit = MenuCancelled THEN IF NOT SrAutoOptions THEN ' If from menu, return CALL ClearScreenNormal(N1) CALL DirectReturnCheck ELSE InHelp = InHelpHold StartupScreen = StartupScreenHold ClockScreen = ClockScreenHold OnEditPage = OnEditPageHold NewGuy = NewGuyHold SrAutoOptions = No TimerDisplaySuppress = TimerDisplaySuppressHold CursorState = CursorStateHold END IF GOTO ExitPoint2 END IF SELECT CASE MenuSrOpt CASE 1 ' Hot Key Change GOSUB NewHotKey CASE 2 ' Pop Date/Time Change IF AllowPopDateTime OR AllowPopDateTimeSave THEN AllowPopDateTime = No AllowPopDateTimeSave = No UserPopDateTime$ = False$ ELSE AllowPopDateTime = Yes UserPopDateTime$ = True$ END IF CASE 3 ' Auto Pop Down Change IF SrAutoPopDown THEN SrAutoPopDown = No ELSE SrAutoPopDown = Yes ' don't let this change SrAutoPopDownHappened = Yes ' do an auto-pop down! END IF CASE N4 ' EMS Memory Change IF SrDontUseEMS THEN SrDontUseEMS = No UseEMS$ = True$ ELSE SrDontUseEMS = Yes UseEMS$ = False$ END IF CASE N5 ' Disk Swap Change NoSwapping = No IF UseDiskSwap$ = False$ THEN SrDiskSwapping = Yes UseDiskSwap$ = True$ ELSE SrDiskSwapping = No UseDiskSwap$ = False$ END IF CASE 6 ' Disk Swap Path Change NewDiskPath: BoxRow = MenuRow + MenuSize + N3 MessageRow = BoxRow - N1 InputResponse$ = SrSwapPath$ CALL ControlledInput(BoxRow, N1, MessageRow, N1, 66, _ ("Enter Drive/Directory for Swap Files " + _ "CALSWAP.000 & 001 & Screen File CALSCRN.DAT"), _ InputResponse$, N0, N1, N1, N1) CALL BlankError IF Keystroke$ = CHR$(Esc) THEN GOTO MemResOptionsMenu ' Make upper case, no leading or trailing spaces SrSwapPath$ = LTRIM$(RTRIM$(UCASE$(InputResponse$))) ' Valid Drive Name and separator IF NOT DirectoryExist(SrSwapPath$) THEN GOTO SwapPathError END IF IF RIGHT$(SrSwapPath$, N1) <> "\" THEN SrSwapPathAdjusted$ = SrSwapPath$ + "\" ELSE SrSwapPathAdjusted$ = SrSwapPath$ END IF EgaFilePath$ = SrSwapPathAdjusted$ + EgaFilename$ EgaFilePath2$ = ASCIIZ$(EgaFilePath$) CASE 7 ' Snow Checking SnowChecking: IF SrSnowCheck THEN 'If turning it off, just CALL SrNoSnow ' do it SrSnowCheck = No ELSE CALL SrCancelAutoScreenSave CALL SrAutoScreenSave(EgaFilePath2$, Ecode%) IF Ecode THEN 'If turning it on, then SnowReset = Yes ' have to kill and restart SrSnowCheck = No ' auto screen save, which ELSE ' is okay, because when SrSnowCheck = Yes ' popped up, there's nothing END IF ' being held END IF CASE 8 ' Protect Non-Standard Screen IF SrPopupOnlyIfScreenSaved THEN SrPopupOnlyIfScreenSaved = No ' Turn off ELSE SrPopupOnlyIfScreenSaved = Yes ' Turn on END IF END SELECT GOTO MemResOptionsMenu '-------------------------------------------------------------------- ' Invalid Swap Path SwapPathError: CALL PrepareforMessage CALL MajorBeeper CALL ShowIt(N0, N0, N0, _ "The Drive & Path You Specified Does Not Exist--Try Again") SrSwapPath$ = ValidSwapPath$ GOTO NewDiskPath ' Try Again '-------------------------------------------------------------------- ' Change Hot Key NewHotKey: CALL ClearScreenNormal(N1) ScreenTitles$(N1) = "Choose Hot Key for Program Pop Up" ScreenTitles$(N2) = "Control and/or Function Key Combination" ScreenTitles$(N3) = "(Please Consult Help Text For Explanation)" CALL Titles(-3) IF NoKeyChoice THEN CALL PrepareforMessage CALL ShowIt(N0, N0, N0, _ "You Must Choose At Least a Control Key or a Function Key") NoKeyChoice = No END IF XCL1 = N12 ' Column Positions XCL2 = 55 MenuRow = N7 CALL ShowIt(N13, MenuRow - N1, XCL1 + N7, "Control Keys") CALL ShowIt(N0, MenuRow - N1, XCL2, "Function Key") CALL Kolors(N6) IF LEN(SrHotKeyName$) > N19 THEN NameWidth = LEN(SrHotKeyName$) ELSE NameWidth = N19 END IF CALL BoxDraw(N1, N20, N23, XCL2 - N11, XCL2 - N11 + NameWidth + N3) CALL ShowIt(N6, N21, (XCL2 - N9), "Current Hot Key Is:") CALL ShowIt(N7, Nm1, N0, SrHotKeyName$) ShiftChoice = SrKshiftHot ScanChoice = SrScanChoice FOR WhichKey = N1 TO N2 ' Calculate Displacements Based On Which Key Half Is Being Selected IF WhichKey = N1 THEN XCL = XCL1 MenuChoice = ShiftChoice + N1 MenuSize = NumberofHotCKeys FOR I = N1 TO MenuSize ' Fill Name Part 1 MenuLines(I) = HotKeyNames$(I) NEXT I FOR I = N1 TO NumberofHotFKeys + N1 ' Show FN Keys IF (I = N1 AND ScanChoice = N0) OR _ (I > N1 AND (I = ScanChoice + N1)) THEN ScanColor = N7 ELSE ScanColor = N6 END IF IF I = N1 THEN ToShow$ = "No F Key" ELSE ToShow$ = "F" + LTRIM$(STR$(I - N1)) END IF CALL ShowIt(ScanColor, MenuRow + I, (XCL2 + N2), ToShow$) NEXT I ELSE XCL = XCL2 MenuChoice = ScanChoice + N1 MenuSize = NumberofHotFKeys + N1 MenuLines(N1) = "No F Key" FOR I = N2 TO MenuSize MenuLines(I) = "F" + LTRIM$(STR$(I - N1))' File Name Part 2 NEXT I FOR I = N1 TO NumberofHotCKeys ' Show C Keys IF I = (ShiftChoice + N1) THEN ScanColor = N7 ELSE ScanColor = N6 END IF CALL ShowIt(ScanColor, (MenuRow + I), (XCL1 + N2), _ (HotKeyNames$(I))) NEXT I END IF CALL MenuDriver(MenuSize, MenuChoice, MenuRow, XCL, No, _ N0, N1, N1) IF MenuExit = MenuCancelled AND WhichKey = N1 THEN RETURN IF WhichKey = N1 THEN ShiftChoice = MenuChoice - N1 ' Clear Left Menu and Leave Chosen Key Name There ' on 2nd cycle through For Loop CALL ShowMult(N6, MenuRow, XCL1, (BoxWidth + N2), _ (MenuSize + N2)) ELSE ScanChoice = MenuChoice - N1 END IF NEXT WhichKey IF ShiftChoice = N0 AND ScanChoice = N0 THEN NoKeyChoice = Yes GOTO NewHotKey END IF SrKshiftHot = ShiftChoice CALL StayResKeyShiftList IF ScanChoice > N0 THEN SrKscanHot = FunctionScanCodes(SrWhichFList, ScanChoice) ELSE SrKscanHot = N0 END IF CALL StayResKeyName RETURN '-------------------------------------------------------------------- ExitPoint2: Subnum = SubnumSave END SUB '========================================================================= SUB StayResPopDown STATIC '========================================================================= DEFINT A-Z SubnumSave = Subnum Subnum = 85 '-------------------------------------------------------------------- ' Become Memory Resident 1st Time or Pop Down if Already Resident '-------------------------------------------------------------------- Keystroke$ = INKEY$ Keystroke$ = Blank0$ ' discard keystroke on pop-down ScreenWait! = 2! AvailableStringSpace& = FRE(Blank0$) ' garbage collection '-------------------------------------------------------------------- LOCATE CursorRow, CursorColumn, N0 ' turn calendar cursor off CALL WindowSave ' and save calendar screen '-------------------------------------------------------------------- IF NOT MemoryResident THEN '-------------------------------------------------------------------- ' First Call To SrPopDown ' Check Whether Options Exist, If Not, Set Them '-------------------------------------------------------------------- IF NOT SrOptionsChosen THEN ' If any menu data exists, InHelpSave = InHelp HardSnooze = Yes IF MenuSingleLine OR InMenu THEN GOSUB RecursiveMenuSave ' save before processing CALL StayResOptions(Yes) ' options, as options menu will IF MenuSingleLineSave OR InMenuSave THEN GOSUB RecursiveMenuRestore END IF InHelp = InHelpSave Keystroke$ = Blank0$ ' clobber previous menu. END IF ' after options are complete '-------------------------------------------------------------------- ' Search the environment for 4DOS and add 7000 to the memory ' protection if found, because 4DOS' command processor is larger. EnvIndex = N1 DO WHILE LEN(ENVIRON$(EnvIndex)) 'Check environment EnvCheck$ = ENVIRON$(EnvIndex) ' comspec for IF INSTR(LCASE$(EnvCheck$), "4dos.com") THEN ' for "4dos.com" Using4DOS = Yes ' yes it's there EXIT DO ELSE Using4DOS = No ' no it's not END IF EnvIndex = EnvIndex + N1 LOOP '-------------------------------------------------------------------- ' See if enough memory for TSR Mode ' SRP4 tests for at least 64K after doing an internal BASIC SETMEM SrUserMemProtect& = 10& * 1024& 'Protect 10K of dynamic MemoryLeft& = FRE(-1) ' Available far memory less ' a margin must be available MemoryOK& = MemoryLeft& - SrUserMemProtect& - 64& * 1024& IF Using4DOS THEN MemoryOK& = MemoryOK& - 7000& END IF IF MemoryOK& < 0& THEN ' If not enough memory, then SrAutoPopDown = No ' cancel AutoPopDown SrAutoPopDownReady = No ' and cancel Pop down with a SrAutoPopDownHappened = No ' message ErrorLine1$ = _ "Temporarily-Needed DOS Memory To Pop Down Is Insufficient By " + _ STR$(-MemoryOK&) + " Bytes" ERROR 253 END IF '-------------------------------------------------------------------- CALL SrAutoScreenSave(EgaFilePath2$, Ecode%) 'Set Screen Save On IF Ecode THEN ErrorLine1$ = _ "Disk Swap/Screen Save File Path is Longer than 65 Bytes" ERROR 253 END IF '-------------------------------------------------------------------- IF NOT SrSetUserMemCalled THEN ' memory (does internal SETMEM) CALL SrSetUserMem(SrUserMemProtect&) SrSetUserMemCalled = Yes END IF '-------------------------------------------------------------------- CALL SrForceFile0 ' Set Swap File Exts to 000 and 001 '-------------------------------------------------------------------- ' Choose EMS or Disk Swapping or Neither Here and Enable EMS '-------------------------------------------------------------------- IF SrDontUseEMS THEN ' EMS Swap Overrides Disk Swap SrEMS = No ELSE CALL SrCheckEMS(Ecode%) IF Ecode THEN ' Set No EMS Available Flag SrEMS = No ELSE ' EMS swapping is set SrEMS = Yes SrDiskSwapping = No END IF END IF '-------------------------------------------------------------------- ' Disk Swapping Initialization IF NOT SrEMS AND SrDiskSwapping THEN SrDiskCantSwap = No CALL SetCurrentDirectory(N2) ' Check Disk Swap Space DiskOK& = 0& IF Ecode THEN ' Ecode returned from last CALL SrDiskCantSwap = Yes ' No Drive ELSE Directory$ = SPACE$(65) CALL MhDisk(DriveSet%, Directory$, FreeDisk&, _ TotalSpace&, Ecode%) IF Ecode THEN SrDiskCantSwap = Yes SwapFileSize& = 228200& ' Obtained by observation DiskOK& = FreeDisk& - SwapFileSize& * N2 IF DiskOK& < 0& AND NOT SrDiskCantSwap THEN SrDiskCantSwap = Yes ELSE ' Initialize Disk Swapping SrDiskPathToSet$ = SrSwapPathAdjusted$ + "calswap" ' Turn On Disk Swapping Here CALL SrSetDiskSwap(SrDiskPathToSet$, SwapEcode%) IF SwapEcode% THEN SrDiskSwapping = No SrDiskCantSwap = Yes ELSE SrDiskSwapped = Yes ' Made It! SrActualSwapPath$ = SrSwapPath$' Save Real Path END IF END IF CALL SetCurrentDirectory(N1) ' Return to calendar END IF END IF '-------------------------------------------------------------------- KscanRes = SrKscanHot 'Set Initial Hot Keys KshiftRes = SrKshiftHot '-------------------------------------------------------------------- END IF '-------------------------------------------------------------------- ' Enable the Pop-Up on Date/Time only if in Clock Screen SrPopString$ = RIGHT$(STR$(SrPopTime#), N12) SrYear = VAL(MID$(SrPopString$, N1, N4)) SrMonth = VAL(MID$(SrPopString$, N5, N2)) SrDay = VAL(MID$(SrPopString$, N7, N2)) SrHour = VAL(MID$(SrPopString$, N9, N2)) SrMinute = VAL(MID$(SrPopString$, N11, N2)) '-------------------------------------------------------------------- ' POPPING DOWN ... or AUTO POP DOWN ... Screen '-------------------------------------------------------------------- TimerDisplaySuppressSave = TimerDisplaySuppress LOCATE , , N0 CALL ClearScreenNormal(N0) CursorStateHold = CursorState CursorState = N0 '-------------------------------------------------------------------- IF AllowPopDateTime * SrPopDateTime * EventTableStable * _ EventsScheduled * ApptFile THEN WhichEvent = N1 CALL ApptToMenu(N1) CALL SrSetTimeY(SrMonth%, SrDay%, SrYear%, SrHour%, SrMinute%) PopShow$ = RTRIM$(LTRIM$(LEFT$(CurrentEventLine$, 76))) IF LEN(PopShow$) < (N80 - N21) THEN PopShowLine = N13 PopShowColumn = N20 ELSE PopShowLine = N14 PopShowColumn = Nm2 ' center long line END IF ELSE CALL SrReleaseTimeY PopShow$ = "Disabled" IF AllowPopDateTimeSave THEN PopShow$ = PopShow$ + " (temporarily)" END IF PopShowLine = N13 PopShowColumn = N0 END IF '-------------------------------------------------------------------- CALL BoxDraw(N2, N1, N25, N1, N80) CALL Kolors(N7) IF SrAutoPopDownReady AND NOT SrAutoPopDownHappened THEN ScreenTag$ = "Auto Pop" ELSE ScreenTag$ = "Popping" END IF CALL BigChars(N3%, N10%, ScreenTag$ + " Down ... ") CALL Kolors(N6) CALL ShowIt(N0, N10, N10, "Hot Key:") 'Line 10 CALL ShowIt(N0, Nm3, N6, "Auto Pop-Up:") 'Line 13 CALL ShowIt(N0, Nm3, N6, "Swap Method:") 'Line 16 CALL ShowIt(N0, Nm1, N8, "Swap Path:") 'Line 17 CALL ShowIt(N0, Nm3, N3, "Screen Restore:") 'Line 20 CALL ShowIt(N0, Nm1, N7, "Video BIOS:") 'Line 21 CALL ShowIt(N0, Nm2, N4, "Pop Down Type:") 'Line 23 CALL ShowIt(N0, Nm1, N6, "DOS Command:") 'Line 24 '-------------------------------------------------------------------- IF ColorCRT THEN CALL Kolors(N7) ELSE CALL Kolors(N4) END IF CALL ShowIt(N0, N10, N20, SrHotKeyName$) CALL ShowIt(N0, PopShowLine, PopShowColumn, PopShow$) '-------------------------------------------------------------------- IF SrEMS THEN CALL ShowIt(N0, N16, N20, "Swapping to Expanded (EMS) Memory") ELSEIF SrDiskSwapped THEN CALL ShowIt(N0, N16, N20, _ "Swapping to Real or Virtual Disk files CALSWAP.000 & 001") IF LEN(SrActualSwapPath$) < (N80 - N21) THEN ShowLine = N17 ShowColumn = N20 ELSE ShowLine = N18 ShowColumn = Nm2 ' center long line END IF CALL ShowIt(N0, ShowLine, ShowColumn, SrActualSwapPath$) ELSE CALL ShowIt(N0, N16, N20, "Program Will Remain In DOS Memory") ScreenTag$ = Blank0$ IF (UseEMS$ = True$) AND NOT SrEMS THEN ScreenTag$ = "No EMS Memory" END IF IF (UseDiskSwap$ = True$) AND SrDiskCantSwap THEN IF LEN(ScreenTag$) THEN ScreenTag$ = ScreenTag$ + " and " IF DiskOK& THEN DiskTag$ = "Disk Space Is " + STR$(DiskOK&) + " Bytes Short" ELSE DiskTag$ = "Disk Drive/Path Not Found" END IF ScreenTag$ = ScreenTag$ + DiskTag$ END IF IF LEN(ScreenTag$) THEN CALL MinorBeeper ' Error Chirp & Longer Wait CALL Kolors(N20) ' Hilit and Blinking CALL ShowIt(N0, Nm1, N25, ScreenTag$) END IF END IF '-------------------------------------------------------------------- IF ColorCRT THEN CALL Kolors(N7) ELSE CALL Kolors(N4) IF NOT MemoryResident OR NOT SrScreenSaved THEN CALL ShowIt(N0, N20, N20, "No Saved Screen To Restore") ELSE ScreenTag$ = "Mode" + STR$(UserMode) + " page" + _ STR$(DOSCursorPage) CALL ShowIt(N0, N21, N20, ScreenTag$) ScreenTag2$ = ScreenModes$(UserMode + N1) SearchFor$ = "x 25" Pointer = InString(ScreenTag2$, SearchFor$) IF Pointer THEN ' fix up the 80 x 25 SELECT CASE UserRows ' label if it's 43 or 50 CASE N43 ' line mode for display TagFix$ = "x 43" CASE N50 TagFix$ = "x 50" CASE ELSE GOTO ShowTag END SELECT CALL Myd2(ScreenTag2$, Pointer%, N4%, TagFix$) END IF ShowTag: CALL ShowIt(N0, N20, N20, ScreenTag2$) END IF IF MemoryResidentShell THEN ScreenTag1$ = "Execute DOS Session with Program or Batch File" ScreenTag2$ = LEFT$(SrShellCommand$, 59) ELSE ScreenTag1$ = "Normal Pop Down" ScreenTag2$ = Blank0$ END IF CALL ShowIt(N0, N23, N20, ScreenTag1$) CALL ShowIt(N0, Nm1, N0, ScreenTag2$) '-------------------------------------------------------------------- InPopDown = Yes ' Avoid Recursive F10's CALL Snooze(ScreenWait!) ' Wait (user reads screen) CALL SetVideoMode(N1) ' Set users mode if necessary '-------------------------------------------------------------------- IF NOT MemoryResident THEN ' if stay-res isn't restoring screen, CALL SetVideoPage(N1) ' set user's page if necessary CALL RestoreDOSKeyState ' And user's cursor and lines SELECT CASE UserMode ' If in text mode CASE 0, 1, 2, 3, 7 ' restore DOS colors CALL Kolors(N99) ' do a cursor, clear screen LOCATE N1, N1, N1, InsertCursorStart, CursorStop CLS END SELECT END IF '-------------------------------------------------------------------- CALL SetCurrentDirectory(N0) ' Set User's Directory '-------------------------------------------------------------------- IF NOT MemoryResidentShell THEN ' If not shelling, make sure to CALL SrCancelShell ' cancel it END IF '-------------------------------------------------------------------- ' Redefine Hot Key on Each Call as User Can Change It CALL SrResetHotKey(SrKscanHot%, SrKshiftHot%) '-------------------------------------------------------------------- DO '--------------------------------------------------------------- CALL SrSetBusyWait(90%) ' Wait 5 seconds if DOS is busy '--------------------------------------------------------------- ' POP DOWN HERE !!!! '--------------------------------------------------------------- CALL SrPopDown(KscanRes%, KshiftRes%, ResEcode%) '--------------------------------------------------------------- ' POP UP HERE !!!! '--------------------------------------------------------------- ' If DOS is busy, we can't go on until finished ' or shelling '--------------------------------------------------------------- DOSBusy = No IF ResEcode = 1 OR _ (NOT SrScreenSaved AND SrPopupOnlyIfScreenSaved) THEN DOSBusy = Yes 'Set up repeat. GOSUB SafeSoundBleep 'Sound the speaker safely END IF '--------------------------------------------------------------- LOOP WHILE DOSBusy ' Loop if DOS or Shelling is Busy '------------------------------------------------------------------------- CALL SaveCurrentDirectory(N0) ' Save User Directory CALL SetCurrentDirectory(N1) ' Set Calendar Directory '------------------------------------------------------------------------- IF NOT MemoryResident AND ResEcode > N1 THEN Ecode = ResEcode MemoryResident = No ERROR 254 ' Did Not Go Resident--Trap Error END IF '-------------------------------------------------------------------- SrAutoPopDownHappened = Yes ' Turn off Auto Pop Down '------------------------------------------------------------------------- MemoryResident = Yes ' We are now memory-resident '------------------------------------------------------------------------- CALL SaveDOSKeyState ' Save user cursor, page, etc '-------------------------------------------------------------------- UserMode = KscanRes ' Save User Video Mode CurrentVideoMode = KscanRes '-------------------------------------------------------------------- CALL SetVideoMode(N0) ' Set Calendar's Video Mode & Page CALL SetVideoPage(N0) '-------------------------------------------------------------------- LOCATE , , N0 ' Turn off cursor '-------------------------------------------------------------------- IF NOT SrScreenSaved AND NOT SrPopupOnlyIfScreenSaved THEN CALL MinorBeeper CALL ClearScreenNormal(N0) CALL BoxDraw(N2, N7, N18, N6, N74) CALL ShowIt (N0, N9, N9, _ "Personal Calendar popped up over a program whose screen is") CALL ShowIt (N0, Nm1, N0, _ "in non-standard video BIOS mode" + STR$(UserMode) + _ ", so the screen can't") CALL ShowIt (N0, Nm1, N0, _ "be saved. On your next pop down to the program, the screen") CALL ShowIt (N0, Nm1, N0, _ "won't be restored. If the industry ever standardizes this") CALL ShowIt (N0, Nm1, N0, _ "video mode, a future version of Personal Calendar will be") CALL ShowIt (N0, Nm1, N0, _ "enhanced to support it. If you'd rather not disturb these") CALL ShowIt (N0, Nm1, N0, _ "non-standard screens (don't pop up over them), reset your") CALL ShowIt (N0, Nm1, N0, _ "Memory-Resident Options accordingly. Press a key ...") DO LOOP UNTIL LEN(INKEY$) END IF '-------------------------------------------------------------------- CALL PoppedOverCheck ' See If Over DOS or Program for Later '-------------------------------------------------------------------- IF KshiftRes = N7 THEN ' Reset Pop On Date/Time SrPopDateTime = No ' so it can't repeat END IF IF AllowPopDateTimeSave THEN AllowPopDateTime = AllowPopDateTimeSave 'Restore Autopop Flag AllowPopDateTimeSave = No END IF ' if turned off '-------------------------------------------------------------------- ' Let user clear batch screen if there is one IF MemoryResidentShell THEN CALL ShowErase(N13, N1, N1, N80, Blank0$) CALL ShowIt(N7, N1, Nm2, _ " Press a Key to Return to Personal Calendar ... ") DO LOOP UNTIL LEN(INKEY$) END IF '-------------------------------------------------------------------- CLS ' Clear the screen '-------------------------------------------------------------------- CALL WindowRestore ' Restore Calendar Screen '-------------------------------------------------------------------- CursorState = CursorStateHold ' Restore Saved Cursor State CALL RestoreCalKeyState ' and key statuses and cursor '-------------------------------------------------------------------- TimerDisplaySuppress = TimerDisplaySuppressSave InPopDown = No GOTO ExitPoint3 '-------------------------------------------------------------------- ' Copied from Tony Elliott's sample program for safe sound ' while DOS is busy SafeSoundBleep: ScreenWait! = 3! OUT 67, 182 'Tell timer that data is coming. OUT &H43, 182 'Set up for sound. OUT &H42, &H33 'Low part of sound. OUT &H42, N5 'High part of sound. SpkrOn% = INP(97) OR &H3 'Turn speaker on by setting OUT 97, SpkrOn% ' bits 0 and 1 of PPI chip. FOR A% = 1 TO 12000 'Delay NEXT OUT &H42, &H33 'Low part second tone. OUT &H42, N6 'High part second tone. FOR A% = 1 TO 12000 NEXT 'Delay. SpkrOff% = INP(97) AND &HFC 'Turn speaker off. OUT 97, SpkrOff% RETURN '-------------------------------------------------------------------- ' Save Menu Parameters RecursiveMenuSave: InMenuSave = InMenu MenuSizeSave = MenuSize MenuChoiceSave = MenuChoice MenuRowSave = MenuRow ReqMenuColumnSave = ReqMenuColumn MenuSingleLineSave = MenuSingleLine MenuSpecialExitSave = MenuSpecialExit ScreenBottomsShowSave = ScreenBottomsShow FilenameShowSave = FilenameShow WhichColorSave = WhichColor WhichColor = N0 CursorStateSave = CursorState AllowInsertModeSave = AllowInsertMode AllowInsertMode = No InsertSave = Insrt NumSave = Num CapsSave = Caps FOR I = N1 TO MenuSizeSave MenuLinesSave$(I) = MenuLines(I) NEXT I RETURN '-------------------------------------------------------------------- ' Restore Menu Parameters RecursiveMenuRestore: FOR I = N1 TO MenuSizeSave MenuLines(I) = MenuLinesSave$(I) NEXT I MenuSize = MenuSizeSave MenuChoice = MenuChoiceSave MenuRow = MenuRowSave ReqMenuColumn = ReqMenuColumnSave MenuSingleLine = MenuSingleLineSave MenuSpecialExit = MenuSpecialExitSave ScreenBottomsShow = ScreenBottomsShowSave FilenameShow = FilenameShowSave WhichColor = WhichColorSave CursorState = CursorStateSave MenuRecursiveReturn = Yes AllowInsertMode = AllowInsertModeSave Insrt = InsertSave Num = NumSave Caps = CapsSave RETURN '-------------------------------------------------------------------- ExitPoint3: HardSnooze = No Subnum = SubnumSave END SUB '========================================================================= FUNCTION Strng$ (RptTimes%, FillChar%) STATIC '========================================================================= ' Generate Top Of Screen Titles ' Pos is Number of Lines, Neg is Number of Lines + DOS Title DEFINT A-Z SubnumSave = Subnum Subnum = 123 Lin$ = SPACE$(RptTimes%) CALL MhString(Lin$, FillChar%) Strng$ = Lin$ Subnum = SubnumSave END FUNCTION '========================================================================= SUB Titles (EntryPoint) STATIC '========================================================================= ' Generate Top Of Screen Titles ' Pos is Number of Lines, Neg is Number of Lines + DOS Title DEFINT A-Z SubnumSave = Subnum Subnum = 86 NumberofLines = ABS(EntryPoint) IF EntryPoint < N0 THEN NumberofLines = NumberofLines + N1 ScreenTitles$(NumberofLines) = "For Your Current DOS Directory" END IF SELECT CASE NumberofLines CASE 1 TO N5 ' Compute Box TitleWidth = N0 FOR I = N1 TO NumberofLines ' Add Character To Beginning and End ScreenTitles$(I) = Blank1$ + ScreenTitles$(I) + Blank1$ IF LEN(ScreenTitles$(I)) > TitleWidth THEN TitleWidth = LEN(ScreenTitles$(I)) END IF NEXT I FOR I = N1 TO NumberofLines CALL ShowIt(N13, I, Nm2, (SPACE$(TitleWidth))) CALL ShowIt(N0, I, Nm2, (ScreenTitles$(I))) NEXT I END SELECT Subnum = SubnumSave END SUB '========================================================================= SUB UnpackApptRecord STATIC '========================================================================= ' Split Appointment File Record Into Individual Variables (Unpack) ' Pos 1- 2 EventYear$ Year Last 2 Digits (00-99) ' 3- 4 EventMonth$ Month 2 Digits (01-12) ' 5- 6 EventDay$ Day 2 Digits (01 -days in month) ' 7- 8 EventHour$ Hour 2 Digits (00-23) ' 9-10 EventMinute$ Minute 2 Digits (00-59) ' 11-63 EventText$ Text TextSize Chars (Alphanumeric and ' specials) ' 68-69 EventLimRepeat$ Limited WDM 2 Digits (01-99 or blank) ' 70-72 EventRepeat$ (Bi)Wkly/Dly/Mthly 1 Alpha/(2 Num or 1 Alpha) ' ("B"/"W"/"D"/"M"/"N"+digits/last) ' 74-75 EventYear1st2$ Year First 2 Digits (19 or 20) ' (Not Displayed) DEFINT A-Z SubnumSave = Subnum Subnum = 87 CALL Myd2(EventYear$, N1%, N2%, CurrentEventRecord$) CALL MhMidString(EventMonth$, N1%, N2%, CurrentEventRecord$, N3%) CALL MhMidString(EventDay$, N1%, N2%, CurrentEventRecord$, N5%) CALL MhMidString(EventHour$, N1%, N2%, CurrentEventRecord$, N7%) CALL MhMidString(EventMinute$, N1%, N2%, CurrentEventRecord$, N9%) CALL MhMidString(EventText$, N1%, TextSize%, CurrentEventRecord$, N11%) CALL MhMidString(EventLimRepeat$, N1%, N2%, CurrentEventRecord$, N68%) CALL MhMidString(EventRepeat$, N1%, N3%, CurrentEventRecord$, N70%) CALL MhMidString(EventYear1st2$, N1%, N2%, CurrentEventRecord$, N74%) Subnum = SubnumSave END SUB '========================================================================= SUB UpdateClockScreen STATIC '========================================================================= DEFINT A-Z SubnumSave = Subnum Subnum = 88 '-------------------------------------------------------------------- ' Update The Display -- '-------------------------------------------------------------------- ' ³ 12 ³ 1 ³ 2 ³ 3 ³ 4 ³ 5 ³ 6 ³ 7 ³ 8 ³ 9 ³ 10 ³ 11 ³ ' ²²°°°°²°°°°²°°°°²°°°°²°°°°²°°°°²°°°°²°°°°²°°°°²°°°°²°°°°²°°°°²² ' 0 5 10 15 20 25 30 35 40 45 50 55 60 '------------------------------------------------------------------------- ' At Least a Second Has Changed--Compute New Values ' ... Since a pop down or SHELL may have occurred, a long time could pass ' ... All values must therefore be checked every time through here '------------------------------------------------------------------------- ' Break Down Into Year, Month, Day, Hour, Minute, Second, and Edit ' CurrentHour Hour CurrentMinute Minute CurrentSecond Second ' DateFromDOS$ = DATE$ ' Save close together in case we're computing TimeFromDOS$ = TIME$ ' across a change (albeit rare) ' TodaysDate$ = MID$(DateFromDOS$, N7, N4) + _ MID$(DateFromDOS$, N1, N2) + MID$(DateFromDOS$, N4, N2) CurrentYear = VAL(MID$(TodaysDate$, N1, N4)) CurrentMonth = VAL(MID$(TodaysDate$, N5, N2)) CurrentDay = VAL(MID$(TodaysDate$, N7, N2)) CALL Myd2(CurrentDateTime$, N1, N8, TodaysDate$) CALL DayDate(TodaysDate$) CurrentDayOfWeek = IndexedDay ' Jul$ = LTRIM$(STR$(JulianDate&)) ' At the Year 2000, Length JuLength = LEN(Jul$) ' can end up "00 001" or 1, so Julian$ = Strng$(N6, N48) ' zeroinit ' adjust CALL Myd2(Julian$, N7 - JuLength, JuLength, Jul$) CALL MhMidString(Julian$, N1%, N2%, Julian$, N2%) CALL Myd2(Julian$, N3, N1, Blank1$) ' CurrentTime$ = MID$(TimeFromDOS$, N1, N2) + _ MID$(TimeFromDOS$, N4, N2) + MID$(TimeFromDOS$, N7, N2) CurrentHour = VAL(MID$(TimeFromDOS$, N1, N2)) CurrentMinute = VAL(MID$(TimeFromDOS$, N4, N2)) CurrentSecond = VAL(MID$(TimeFromDOS$, N7, N2)) CurrentQuarter = CurrentMinute \ N15 + N1 ' Combine Date/Time In Format yyyymmddhhmm For Testing CALL Myd2(CurrentDateTime$, N9, N4, CurrentTime$) CurrentDateTime# = VAL(CurrentDateTime$) '------------------------------------------------------------------------- ' Set First Time Prior Values IF FirstTimeClock THEN '-------------------------------------------------------------------- ' On First Time, Initialize Prior Values For Clock Display PreviousHour = CurrentHour - N1 IF CurrentHour = N0 THEN PreviousHour = N23 PreviousMinute = CurrentMinute - N1 IF CurrentMinute = N0 THEN PreviousMinute = 59 PreviousSecond = CurrentSecond - N1 IF CurrentSecond = N0 THEN PreviousSecond = 59 PreviousQuarter = CurrentQuarter END IF '------------------------------------------------------------------------- IF FirstTimeClock OR TimeBlock OR WholeClock OR _ PreviousDate$ <> TodaysDate$ THEN DisplayYear$ = MID$(TodaysDate$, N1, N4) IF MID$(TodaysDate$, N7, N1) = Zeroo$ THEN DisplayDay$ = RIGHT$(TodaysDate$, N1) ELSE DisplayDay$ = RIGHT$(TodaysDate$, N2) END IF FullClockDate$ = DayNames$(CurrentDayOfWeek) + ", " + _ DisplayDay$ + Blank1$ + MonthNames$(CurrentMonth) + _ Blank1$ + DisplayYear$ '-------------------------------------------------------------------- ' Construct and Display Date In English CALL ShowErase(N3, (ClockRow + N4), (ClockColumn + N14), 36, Blank0$) CALL ShowIt(N7, N0, (ClockColumn + N14 + _ (36 - LEN(FullClockDate$)) \ N2), FullClockDate$) CALL ShowIt(N3, (ClockRow + N5), (ClockColumn + N28), _ (" (" + Julian$ + ") ")) END IF '------------------------------------------------------------------------- ' Label and Position for Hour Display (order is 12,1,2,3,4,5,...) IF FirstTimeClock OR TimeBlock OR WholeClock OR _ CurrentHour <> PreviousHour THEN IF CurrentHour > N11 THEN PMAM$ = "PM" ELSE PMAM$ = "AM" CurrentDisplayHour = CurrentHour IF CurrentHour > N12 THEN CurrentDisplayHour = CurrentDisplayHour - N12 END IF IF CurrentDisplayHour = N0 THEN CurrentDisplayHour = N12 ' midnight END IF IF CurrentDisplayHour = N12 THEN CurrentHourPosition = N1 ELSE CurrentHourPosition = CurrentDisplayHour + N1 END IF IF FirstTimeClock THEN PrevQuarterPosition = CurrentHourPosition END IF Hours12Hour$ = BlankFill$(RIGHT$(STR$(CurrentDisplayHour), N2)) Hours24Hour$ = ZeroFill$(RIGHT$(STR$(CurrentHour), N2)) CurrentHour$ = BlankFill$(RIGHT$(STR$(CurrentDisplayHour), N2)) PreviousDisplayHour = PreviousHour IF PreviousHour > N12 THEN PreviousDisplayHour = PreviousDisplayHour - N12 END IF IF PreviousDisplayHour = N0 THEN PreviousDisplayHour = N12 ' midnight END IF ' IF PreviousDisplayHour = N12 THEN PreviousHourPosition = N1 ELSE PreviousHourPosition = PreviousDisplayHour + N1 END IF ' PreviousHour$ = BlankFill$(RIGHT$(STR$(PreviousDisplayHour), N2)) '-------------------------------------------------------------------- ' Hilight and Dehilight Current and Previous Hour Block On Clock CALL ShowIt(N10, (ClockRow + N1), (ClockColumn + N5 * _ PreviousHourPosition - N1), (SPACE$(N4))) CALL ShowIt(N14, N0, (ClockColumn + N5 * CurrentHourPosition - N1), _ (SPACE$(N4))) '-------------------------------------------------------------------- ' Hilight and Dehilight Current and Previous Hours On Clock CALL ShowIt(N10, N0, (ClockColumn + N5 * PreviousHourPosition), _ PreviousHour$) CALL ShowIt(N14, N0, (ClockColumn + N5 * CurrentHourPosition), _ CurrentHour$) END IF '------------------------------------------------------------------------- IF FirstTimeClock OR TimeBlock OR WholeClock OR _ CurrentMinute <> PreviousMinute THEN CurrentQuarter = CurrentMinute \ N15 + N1 DisplayMinutes$ = ZeroFill$(RIGHT$(STR$(CurrentMinute), N2)) '-------------------------------------------------------------------- ' Hilight and Dehilight Current and Previous Quarter Hour Markers CALL ShowIt(N3, (ClockRow + N2), (ClockColumn + N5 * _ (PrevQuarterPosition - N1) + PreviousQuarter + N3), _ ClockPositionGraphic$) CALL ShowIt(N14, N0, (ClockColumn + N5 * (CurrentHourPosition - _ N1) + CurrentQuarter + N3), MovingClockTick$) '-------------------------------------------------------------------- ' Hilight and Dehilight Previous and Current Minute Markers On Clock ' Previous Minute ScreenRow = ClockRow + N6 ScreenColumn = ClockColumn + PreviousMinute + N3 ' (Don't Kill Current Second By Previous Minute) IF ScreenColumn <> (ClockColumn + CurrentSecond + N3) THEN IF (PreviousMinute MOD N5) = N0 THEN CALL ShowIt(N3, N0, N0, ClockSeparatorGraphic$) ELSE CALL ShowIt(N3, N0, N0, ClockPositionGraphic$) END IF END IF ' Current Minute ScreenColumn = ClockColumn + CurrentMinute + N3 CALL ShowIt(N14, N0, N0, MovingClockTick$) END IF '------------------------------------------------------------------------- DisplaySeconds$ = ZeroFill$(RIGHT$(STR$(CurrentSecond), N2)) '------------------------------------------------------------------------- ' Display Time In 24-Hour Format CALL ShowIt(N7, (ClockRow + N4), (ClockColumn + N6), (Hours24Hour$ + _ ":" + DisplayMinutes$ + ":" + DisplaySeconds$)) '------------------------------------------------------------------------- ' Display Time In 12-Hour Format CALL ShowIt(N7, N0, (ClockColumn + N50), (Hours12Hour$ + ":" + _ DisplayMinutes$ + ":" + DisplaySeconds$ + Blank1$ + PMAM$)) '------------------------------------------------------------------------- ' Hilight and Dehilight Previous and Current Second Markers On Clock ' Previous Second ScreenRow = ClockRow + N6 ScreenColumn = ClockColumn + PreviousSecond + N3 ' (Don't Kill Current Minute By Previous Second) IF ScreenColumn <> (ClockColumn + CurrentMinute + N3) THEN IF (PreviousSecond MOD N5) = N0 THEN CALL ShowIt(N3, N0, N0, ClockSeparatorGraphic$) ELSE CALL ShowIt(N3, N0, N0, ClockPositionGraphic$) END IF END IF ' Current Second CALL ShowIt(N14, N0, (ClockColumn + CurrentSecond + N3), MovingClockTick$) '------------------------------------------------------------------------- ' END OF TIME BLOCK CHANGES '------------------------------------------------------------------------- ' SET CHIME COUNT FOR HOUR OR QUARTER HOUR -- RINGS IN MAIN PROGRAM '------------------------------------------------------------------------- IF CurrentSecond = N0 THEN ' Chime is set only on EXACT second IF CurrentMinute = N0 THEN ' to avoid residual chiming '--------------------------------------------------------------- ' Chime on hour, Chime is Hour base 12 ChimeCount = CurrentDisplayHour ELSEIF CurrentMinute MOD N15 = N0 THEN '--------------------------------------------------------------- ' Chime On Quarter Hour (15,30,45--once,twice,thrice) ChimeCount = CurrentMinute \ N15 END IF END IF '------------------------------------------------------------------------- ' DAY OR EVENT CHANGED--SHOW NEW CALENDARS '------------------------------------------------------------------------- IF RedisplayCalendars OR TodaysDate$ <> PreviousDate$ THEN '-------------------------------------------------------------------- ' Day Has Changed, Display Calendars ' (CalendarDate$ Date To Display Calendars For) IF NormalCalendars THEN OtherCalendars = No CalendarDate$ = TodaysDate$ ELSE OtherCalendars = Yes END IF CALL PrintCalendar TimeBlock = Yes RedisplayNotesEvents = Yes END IF '------------------------------------------------------------------------- Subnum = SubnumSave END SUB '========================================================================= SUB ValidateEventDate STATIC '========================================================================= ' Accept Date In Editing, Check Validity And Change If Wrong, Delete DEFINT A-Z SubnumSave = Subnum Subnum = 89 EventValidationError = N0 ReturnMessage$ = Blank0$ '========================================================================= ' Get The Event Repeat Type EventRepeatType$ = LEFT$(EventRepeat$, N1) ' Limit the Allowable Repeat Types IF InString("XxBbDdWwMmNnQqYy123456789", EventRepeatType$) = N0 THEN EventRepeatType$ = Blank1$ EventRepeat$ = SPACE$(N3) EventLimRepeat$ = SPACE$(N2) GOTO CheckNumerics END IF ' Test If Numeric for Multiweek ' Non-Numeric ' Make Upper Case If Needed IF NumberError(EventRepeatType$) = N1 AND _ (EventRepeatType$ < "A" OR EventRepeatType$ > "Z") THEN EventRepeatType$ = CHR$(ASC(EventRepeatType$) - N32) CALL Myd2(EventRepeat$, N1, N1, EventRepeatType$) END IF ' If "X" then Delete the Event IF EventRepeatType$ = "X" THEN ' And write the Deleted Record to History CALL ApptToMenu(N1) IF CurrentEventRecord$ <> Blank80$ THEN EventtoHistory = Yes HistoryBuffer$ = CurrentEventLine$ CALL WritetoHistory CurrentEventRecord$ = Blank80$ CALL MhLset(ApptBuffer$, Blank80$) EventTableStable = No CALL PutApptRecord(N1 + WhichEvent) ' Put out the Old Record CALL UnpackApptRecord ' Build Blank Menu Line EventDate$ = Blank8$ EventTime$ = SPACE$(N4) END IF ' Write History and Blank out Record GOTO ExitPoint4 END IF '========================================================================= ' If Limited Event, Edit Repeat Value, Present Consistently FOR JJ = N1 TO N2 IF InString(" 0123456789", MID$(EventLimRepeat$, JJ, N1)) = N0 THEN ReturnMessage$ = "Invalid Repeat" GOTO ErrorReturn END IF NEXT JJ IF VAL(EventLimRepeat$) < N1 THEN EventLimRepeat$ = SPACE$(N2) ELSE EventLimRepeat$ = RIGHT$(STR$(VAL(EventLimRepeat$)), N2) END IF '========================================================================= ' If "D" then Daily Event IF EventRepeatType$ = "D" THEN ' Update Date EventRepeat$ = "D " END IF '------------------------------------------------------------------------- ' If "B" or "W" or Multiweekly or Special Monthly "N" ' -- Make Sure Date is Correct for the Day of Week/Week of Month IF InString("BWN123456789", EventRepeatType$) THEN ' All Weekly Forms Must Have a Day of the Week IF InString("1234567", MID$(EventRepeat$, N2, N1)) = N0 THEN ReturnMessage$ = "Invalid Week Day" GOTO ErrorReturn END IF IF EventRepeatType$ <> "N" THEN CALL Myd2(EventRepeat$, N3, N1, Blank1$) ' B/W/Multi No 3rd Digit ELSE ' Special Monthly Must Have Which Week Specified IF InString("12345", MID$(EventRepeat$, N3, N1)) = N0 THEN ReturnMessage$ = "Invalid Week" GOTO ErrorReturn END IF END IF END IF '------------------------------------------------------------------------- ' If "M" or "Q" or "Y" then Monthly or Quarterly or Yearly Event ' -- Make Sure Date Correct or Last Day IF InString("MQY", EventRepeatType$) THEN IF InString("Ll", MID$(EventRepeat$, N2, N1)) THEN CALL Myd2(EventRepeat$, N2, N2, "L ") ELSE TestDay = VAL(MID$(EventRepeat$, N2, N2)) IF TestDay < N1 OR TestDay > 31 THEN ReturnMessage$ = "Invalid Day" GOTO ErrorReturn END IF END IF END IF '========================================================================= ' Cursory Check for Numerics in Dates and Times CheckNumerics: IF EventDate$ <> Blank8$ THEN IF NumberError(EventDate$) THEN ReturnMessage$ = "Non-Numeric Date" GOTO ErrorReturn END IF END IF IF EventTime$ <> SPACE$(N4) THEN IF NumberError(EventTime$) THEN ReturnMessage$ = "Non-Numeric Time" GOTO ErrorReturn END IF END IF '------------------------------------------------------------------------- ' Allow a Completely Blank Record EventTest$ = EventDate$ + EventTime$ + EventText$ + EventRepeat$ + _ EventLimRepeat$ IF EventTest$ = SPACE$(LEN(EventTest$)) THEN GOTO ExitPoint4 ' Next Date If Recurring '------------------------------------------------------------------------- ' If No Date Is Given, Fill In Today's IF EventDate$ = Blank8$ THEN EventDate$ = TodaysDate$ '------------------------------------------------------------------------- ' If No Time is Given, Fill In Current IF EventTime$ = SPACE$(N4) THEN EventTime$ = MID$(CurrentTime$, N1, N4) '------------------------------------------------------------------------- ' If Special Monthly, Set A Counter For Which Week of the Month IF EventRepeatType$ = "N" THEN SpecMonthlyCount = VAL(MID$(EventRepeat$, N3, N1)) ' Determine a Working Date To Start From For Computation ' If Month Is Earlier, Check Just Year And Month IF MID$(EventDate$, N1, N6) < MID$(TodaysDate$, N1, N6) THEN CALL Myd2(EventDate$, N1, N6, TodaysDate$) END IF ' And Start At First Day Of Month MonthStart: CALL Myd2(EventDate$, N7, N2, "01")'Start at First Day of the Month '-------------------------------------------------------------------- ' If Rescheduling Special Monthly, First Increment Month, Maybe Year IF Rescheduling THEN Rescheduling = No SpecMonth = VAL(MID$(EventDate$, N5, N2)) SpecMonth = SpecMonth + N1 IF SpecMonth > N12 THEN SpecYear = VAL(MID$(EventDate$, N1, N4)) SpecYear = SpecYear + N1 SpecMonth = N1 CALL YearAdjust(SpecYear, AdjustedYear$) CALL Myd2(EventDate$, N1, N4, AdjustedYear$) END IF CALL Myd2(EventDate$, N5, N2, (RIGHT$(STR$(SpecMonth), N2))) EventDate$ = ZeroFill$(EventDate$) 'Zero Fill Event Date END IF GOSUB SpecialMonthly 'Get The Month-End Limits For Special Monthly ELSE DO ' Not Special Monthlies CALL KeyStuff(KeyStatus) '--------------------------------------------------------------- ' Is the Given Date In the Future? IF EventDate$ > TodaysDate$ THEN EXIT DO ' Future Date ELSE EventDate$ = TodaysDate$ ' No Earlier Dates END IF '--------------------------------------------------------------- ' Has the Time Past? IF EventTime$ > MID$(CurrentTime$, N1, N4) THEN EXIT DO ELSE MultiweekCount = VAL(EventRepeatType$)'Multiweek Counter END IF ' Set the Multiweek Counter For Rescheduling MultiWeekCounter: IF InString("MQY", EventRepeatType$) = N0 THEN 'Bump Date CALL IncrementDate(EventDate$) ' unless Monthly/ END IF ' Quarterly/Yearly IF InString("MNQY", EventRepeatType$) THEN EXIT DO ' Then Logic Below END IF LOOP ' Will Handle END IF ' Now/Older, Increment/Re-Store '------------------------------------------------------------------------- ' Daily, Monthly, Quarter/Yearly (and Special), Bi/Multi-weekly, Weekly SELECT CASE InString("BDWMN123456789QY", EventRepeatType$) CASE 1, 3, N5 TO N14 ' Any repeat on a day of the week ' Weekend Scheduling Not Allowed or ' Weekly or Biweekly or Special Monthly DailyOnWeekend: CALL DayDate(EventDate$) DayofWeek = IndexedDay IF EventRepeatType$ = "D" THEN ' Daily, Disallow Saturday And Sunday IF DayofWeek = N7 OR DayofWeek = N1 THEN GOTO MultiWeekCounter END IF GOTO ExitPoint4 END IF '--------------------------------------------------------------- ' Bi/MultiWeekly or Weekly or Special Monthly (BWN), ' Check the Day IF DayofWeek <> VAL(MID$(EventRepeat$, N2, N1)) THEN GOTO MultiWeekCounter END IF ' Day of Week is Equal to Day Desired ' If BiWeekly Event Is Being Rescheduled, ' Skip the First Equality ' and Stop on The Second, Else Accept First Good Check ' If Special Monthly, Make Sure Month Hasn't Run Off The End ' (Not Always 5th week's day available) IF EventRepeatType$ <> "N" THEN IF NOT Rescheduling OR _ InString("B23456789", EventRepeatType$) = N0 THEN GOTO ExitPoint4 END IF ' Multi-Weekly -- Decrease Multiweek Counter MultiweekCount = MultiweekCount - N1 ' Reset Flag to Stop on Last Week Match -- ' Either Numeric or Biweekly IF MultiweekCount < N2 THEN Rescheduling = No GOTO MultiWeekCounter END IF '--------------------------------------------------------------- ' Special Monthly -- Specific Week and Day of the Month ' Now Count 7 More Days For Each Week Remaining, If Any ThisDay = VAL(MID$(EventDate$, N7, N2)) AddDays = N7 * (SpecMonthlyCount - N1) EndDay = ThisDay + AddDays IF EndDay > TestDay THEN EndDay = EndDay - N7 CALL Myd2(EventDate$, N7, N2, (RIGHT$(STR$(EndDay), N2))) EventDate$ = ZeroFill$(EventDate$) ' Zero Fill Event Date '--------------------------------------------------------------- ' Now Check The Result, ' If Earlier Than Now, Pretend to Reschedule for ' Next Month To Increment The Month And Do It All Again IF EventDate$ < TodaysDate$ OR _ (EventDate$ = TodaysDate$ AND _ EventTime$ <= MID$(CurrentTime$, N1, N4)) THEN Rescheduling = Yes GOTO MonthStart END IF ' Result Is Good And Now or Later -- Exit CASE 2 ' "D"aily ' On Daily Events, Check if Weekend Scheduling Allowed IF WeekendScheduling$ = False$ THEN GOTO DailyOnWeekend CASE N4, N15, N16 ' "M"onthly, "Q"uarterly, "Y"early on specific day ' Monthly, Check the Day or "L"ast DO CALL KeyStuff(KeyStatus) GOSUB SpecialMonthly ' Limit to Last Day ' Put Resulting Day Back in Date For ' Display and Scheduling EventDay$ = ZeroFill$(RIGHT$(STR$(TestDay), N2)) CALL Myd2(EventDate$, N7, N2, EventDay$) IF EventDate$ > TodaysDate$ OR _ (EventDate$ = TodaysDate$ AND _ EventTime$ > MID$(CurrentTime$, N1, N4)) THEN GOTO ExitPoint4 END IF ' Generated Monthly/Quarterly/Yearly Date Is Too Old, ' Increment Month/Quarter/Year and Try Again SELECT CASE EventRepeatType$ CASE "M" TestMonth = TestMonth + N1 CASE "Q" TestMonth = TestMonth + N3 CASE "Y" TestYear = TestYear + N1 END SELECT IF TestMonth > N12 THEN TestMonth = TestMonth MOD N12 TestYear = TestYear + N1 END IF CALL Myd2(EventDate$, N5, N2, _ (RIGHT$(STR$(TestMonth), N2))) CALL YearAdjust(TestYear, AdjustedYear$) CALL Myd2(EventDate$, N1, N4, AdjustedYear$) EventDate$ = ZeroFill$(EventDate$) ' Zero Fill Event Date LOOP END SELECT GOTO ExitPoint4 '------------------------------------------------------------------------- SpecialMonthly: TestYear = VAL(MID$(EventDate$, N1, N4)) TestMonth = VAL(MID$(EventDate$, N5, N2)) ' Last or Actual Method? Or Special Monthly to Set TestDay IF MID$(EventRepeat$, N2, N1) = "L" OR EventRepeatType$ = "N" THEN ' Last Day Method LastDayMethod: IF TestMonth = N2 THEN IF Leap(TestYear) THEN TestDay = N29 ELSE TestDay = N28 END IF ELSE TestDay = MonthLength(TestMonth) END IF RETURN ELSE ' Actual Day Method TestDay = VAL(MID$(EventRepeat$, N2, N2)) IF TestDay <= MonthLength(TestMonth) THEN RETURN ' Too Large GOTO LastDayMethod END IF '------------------------------------------------------------------------- ' Error Return ErrorReturn: EventValidationError = N1 '------------------------------------------------------------------------- ExitPoint4: Subnum = SubnumSave END SUB '========================================================================= SUB VideoMonitorType STATIC '========================================================================= DEFINT A-Z SubnumSave = Subnum Subnum = 90 ' See whether monitor is mono or color CALL MhDisplay (DispMode%, DispColumns%, DispRows%, Memory%, _ DisplayType%) IF DisplayType < 128 OR (NOT MemoryResident AND _ COMMAND$ = "COLOR2MON") THEN MonoCRT = Yes ColorCRT = No CalMode = N7 ELSE ' Mono simulation unless resident ColorCRT = Yes MonoCRT = No CalMode = N3 END IF Subnum = SubnumSave END SUB ' (may be false if we never go resident) '========================================================================= SUB WindowInit STATIC '========================================================================= DEFINT A-Z SubnumSave = Subnum Subnum = 91 ' Initialize Window Manager for Cal & User screens save & restore WindDtaseg = VARSEG(WindowBuffer(N1))'(1 4000-byte bufs+ 8 ctl bytes) CALL MhWind(N0%, WindDtaseg%, N0%, ScreenPage%, N1%, _ N1%, N25%, N80%, N1%, 4008%, Ecode%) IF Ecode THEN ERROR 255 WindowInitted = Yes Subnum = SubnumSave END SUB '========================================================================= SUB WindowRestore STATIC '========================================================================= DEFINT A-Z SubnumSave = Subnum Subnum = 92 WindDtaseg = VARSEG(WindowBuffer(N1)) ' Restore User/Calendar Screen CALL MhWind(N0%, WindDtaseg%, N2%, ScreenPage%, N1%, _ N1%, N25%, N80%, N1%, N0%, Ecode%) IF Ecode THEN ERROR 255 Subnum = SubnumSave END SUB '========================================================================= SUB WindowSave STATIC '========================================================================= DEFINT A-Z SubnumSave = Subnum Subnum = 93 IF NOT WindowInitted THEN CALL WindowInit ' Initialize Window Manager WindowError = No ' Save User/Calendar Screen DO WindDtaseg = VARSEG(WindowBuffer(N1%)) CALL MhWind(N0%, WindDtaseg%, N1%, ScreenPage%, _ N1%, N1%, N25%, N80%, N1%, N0%, Ecode%) IF Ecode = N0 OR (WindowError AND Ecode <> N0) THEN EXIT DO IF Ecode = N5 THEN ' Shrink buffer one screen, one try WindDtaseg = VARSEG(WindowBuffer(N1%)) CALL MhWind(N0%, WindDtaseg%, N3%, 4000%, _ N1%, N1%, N25%, N80%, N1%, N0%, Ecode%) IF Ecode THEN EXIT DO ELSE WindowError = Yes ' (shrunk) END IF LOOP WHILE WindowError IF Ecode THEN ERROR 255 Subnum = SubnumSave END SUB '========================================================================= SUB WriteCalauto STATIC '========================================================================= DEFINT A-Z SubnumSave = Subnum Subnum = 94 CLOSE FilenumAuto OPEN "O", FilenumAuto, "calauto.dat" WriteAppt$ = ApptFilename$ WritePass$ = ApptPassword$ IF AutostartMode THEN AutoMode$ = True$ ELSE AutoMode$ = False$ WriteAppt$ = Blank8$ WritePass$ = Blank8$ END IF WRITE #FilenumAuto, WriteAppt$, WritePass$, AutoMode$, ForceDate CLOSE FilenumAuto Subnum = SubnumSave END SUB '========================================================================= SUB WriteCalDOS STATIC '========================================================================= DEFINT A-Z SubnumSave = Subnum Subnum = 95 CLOSE FilenumDOS OPEN "O", FilenumDOS, "caldos.dat" WRITE #FilenumDOS, DOSCommand$ CLOSE FilenumDOS Subnum = SubnumSave END SUB '========================================================================= SUB WriteCalexcl STATIC '========================================================================= ' Write Exclusion File DEFINT A-Z SubnumSave = Subnum Subnum = 96 CLOSE FilenumExcl OPEN "O", FilenumExcl, "calexcl.dat" FOR J = N1 TO N2 WRITE #FilenumExcl, ExcludefromHistory$(J) NEXT J CLOSE FilenumExcl Subnum = SubnumSave END SUB '========================================================================= SUB WriteCalfig STATIC '========================================================================= DEFINT A-Z SubnumSave = Subnum Subnum = 97 CLOSE FilenumFig OPEN "O", FilenumFig, "calfig.dat" WRITE #FilenumFig, Chf, Chb, Cl1f, Cl1b, Cl2f, Cl2b, Cl3f, _ Cl3b, Cl4f, Cl4b, Cl5f, Cl5b, Cl6f, Cl6b CLOSE FilenumFig Subnum = SubnumSave END SUB '========================================================================= SUB WriteCalmusic STATIC '========================================================================= ' Write Entry DEFINT A-Z SubnumSave = Subnum Subnum = 98 CLOSE FilenumMusic OPEN "O", FilenumMusic, "calmusic.dat" WRITE #FilenumMusic, Alarm$, Chime$, Warning$ CLOSE FilenumMusic Subnum = SubnumSave END SUB '========================================================================= SUB WriteCalres STATIC '========================================================================= DEFINT A-Z SubnumSave = Subnum Subnum = 99 CLOSE FilenumRes OPEN "O", FilenumRes, "calres.dat" ' Initials aren't used in SRP 4, hence dummy "CL" WRITE #FilenumRes, EverResident$, UserPopDateTime$, UseDiskSwap$, _ UseEMS$, SrSwapPath$, "CL", SrKscanHot, SrKshiftHot, _ SrAutoPopDown, SrSnowCheck, SrPopupOnlyIfScreenSaved CLOSE FilenumRes Subnum = SubnumSave END SUB '========================================================================= SUB WritetoHistory STATIC '========================================================================= DEFINT A-Z SubnumSave = Subnum Subnum = 100 ' If a note, write directly, else check for exclusion IF EventtoHistory THEN ' If recording event, exclude refrain text FOR J = N1 TO N2 IF ExcludefromHistory$(J) = MID$(HistoryBuffer$, N28, TextSize) _ OR SPACE$(TextSize) = MID$(HistoryBuffer$, N28, TextSize) THEN GOTO ExitPoint5 END IF NEXT J END IF ' Write to History if Not Blank IF HistoryBuffer$ <> Blank80$ THEN CALL MhLset(ApptBuffer$, HistoryBuffer$) Pointer = N1 + LOF(FilenumAppt) \ N80 CALL PutApptRecord(Pointer) END IF ExitPoint5: Subnum = SubnumSave END SUB '========================================================================= SUB YearAdjust (YeartoAdjust, AdjustedYear$) STATIC '========================================================================= ' Given a Numeric Year, Right-Adjust It In A String Of 4 Length ' Input is YeartoAdjust--numeric, Output is AdjustedYear$--String DEFINT A-Z SubnumSave = Subnum Subnum = 101 AdjustedYear$ = SPACE$(N4) RawYear$ = STR$(YeartoAdjust) YearLength = LEN(RawYear$) - N1 RawYear$ = RIGHT$(RawYear$, YearLength) CALL Myd2(AdjustedYear$, N5 - YearLength, YearLength, RawYear$) Subnum = SubnumSave END SUB '========================================================================= FUNCTION ZeroFill$ (ToZeroFill$) STATIC '========================================================================= DEFINT A-Z SubnumSave = Subnum Subnum = 102 FillDummy$ = ToZeroFill$ DO J = InString(FillDummy$, Blank1$) IF J THEN CALL Myd2(FillDummy$, J, N1, Zeroo$) ELSE EXIT DO END IF LOOP ZeroFill$ = FillDummy$ Subnum = SubnumSave END FUNCTION '======================================================================== '======================== END OF CAL6.BAS ============================= '========================================================================