'========================================================================= ' Personal Calendar (PC) Program ' Copyright (c) 1985-1990, Paul Munoz-Colman. All Rights Reserved. ' Version 14.10 ' 31 Oct 1990 ' Shareware $25 '========================================================================= ' DOS File CAL2.BAS ' Independently Compiled Subprogram Which Is 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' '========================================================================= ' Only Subprogram in this File ' (compiled WITHOUT error handling--no /E or /X) '------------------------------------------------------------------------- ' Name Purpose ' --------------------------- --------------------------------------- ' MainSub Main Procedure '========================================================================= SUB MainSub (MainEntryPoint) STATIC '========================================================================= DEFINT A-Z SubnumSave = Subnum Subnum = 1 '========================================================================= ' This Procedure Exits ONLY Through a Trapped Error and Always Returns ' (except in primitive mode, which ends in the main program) '========================================================================= IF MainEntryPoint = 2 THEN GOTO StartupScreenExit '========================================================================= IF MainEntryPoint = 3 THEN GOTO MainMenuEntry '========================================================================= ' MainEntryPoint = 1 is the Startup Entry -- below '========================================================================= ' Initialize required variables for primitive state '----------------------------------------------------------- N0 = 0 ' Variables instead of constants N1 = 1 ' save program size and stack space N2 = 2 ' big time !! N3 = 3 ' These are the most frequently used. N4 = 4 N5 = 5 N6 = 6 N7 = 7 N8 = 8 N9 = 9 N10 = 10 N11 = 11 N12 = 12 N13 = 13 N14 = 14 N15 = 15 N16 = 16 N17 = 17 N18 = 18 N19 = 19 N20 = 20 N21 = 21 N22 = 22 N23 = 23 N24 = 24 N25 = 25 N26 = 26 N27 = 27 N28 = 28 N29 = 29 N30 = 30 N32 = 32 N34 = 34 N38 = 38 N39 = 39 N40 = 40 N42 = 42 N43 = 43 N45 = 45 N48 = 48 N49 = 49 N50 = 50 N52 = 52 N53 = 53 N54 = 54 N58 = 58 N60 = 60 N62 = 62 N63 = 63 N64 = 64 N68 = 68 N70 = 70 N71 = 71 N72 = 72 N74 = 74 N75 = 75 N80 = 80 N99 = 99 Nm1 = -1 Nm2 = -2 Nm3 = -3 Blank0$ = "" ' Null String Blank1$ = " " ' 1 Blank Space Blank2$ = SPACE$(2) ' 2 Blank Spaces Blank3$ = SPACE$(3) ' 3 Blank Spaces Blank4$ = SPACE$(4) ' 4 Blank Spaces Blank8$ = SPACE$(8) ' 8 Blank Spaces Blank12$ = SPACE$(12) ' 12 Blank Spaces Blank80$ = SPACE$(80) ' 80 Blank Spaces Hyphen$ = "-" False$ = "n" ' Logical No Zeroo$ = "0" No = N0 ' Numeric No Noo$ = "No" True$ = "y" ' Logical Yes Yess$ = "Yes" Yes = Nm1 ' Numeric Yes WindowInitted = No ' Window Manager Initialization ErrMsgPlacement = 5 PrimitiveState = Yes '========================================================================= ' Assign File Numbers for I/O FilenumAppt = N1 ' File number of Appointment File FilenumApptSort = N2 ' File number of Appointment Sort File FilenumAuto = N3 ' File number of Automatic Start File FilenumCopy = N4 ' File number of ASCII Copy File FilenumDOS = N5 ' File number of DOS Command File FilenumError = N6 ' File number of Error Message File FilenumExcl = N7 ' File number of History Exclude File FilenumFig = N8 ' File number of Color Choice File FilenumHelp = N9 ' File number of Help Text File FilenumInit = N10 ' File number of Program Init File FilenumMusic = N11 ' File number of Music Choice File FilenumNewAppt = N12 ' File number of New Appt File FilenumOverdue = N13 ' File number of Overdue Events (.clv) FilenumRes = N14 ' File number of Stay-Res Option File FilenumSer = N15 ' File number of Registration Data '------------------------------------------------------------------------- CALL MhDver(DOSMajorVersion%, DOSMinorVersion%) ' Get DOS Version IF DOSMajorVersion < N3 THEN 'Get DOS Version DOS2x = Yes 'TSR features disabled if not ELSE ' 3.0 or later DOS2x = No END IF '========================================================================= ' Stay-Res Initialization -- Part 1 of 2 '========================================================================= IF NOT DOS2x THEN 'See if program already in CALL StayResInitialization(N0) ' memory, if so pop up, if not, END IF ' terminate this copy '========================================================================= Insrt% = -2 PriorInsert = -2 ScreenPage = N0 ' Set calendar screen page HardSnooze = Yes ' Don't allow Snooze interruption CALL VideoMonitorType ' Determine Color or Monochrome IF ColorCRT THEN ' Set Color Defaults Cl1f = N1 ' Blue on Whi Events (1) and (8) Cl1b = N7 Cl2f = N4 ' Red on Whi Notes (2) and (9) Cl2b = N7 Cl3f = N9 ' BrBlu on blk Clocks (3) and (10) Cl4f = N3 ' Cyan on blk Calendars (4) and (11) Cl5f = N15 ' BrWhi on blu Menus (5) and (12) Cl5b = N1 Cl6f = N2 ' Grn on blk Instructions (6) and (13) Chf = N15 ' BrWhi on blk Emphasis (7) and (14) ELSE Cl1f = N7 ' Monochrome Settings Cl2f = N7 Cl3f = N7 Cl4f = N7 Cl5f = N7 Cl6f = N7 Chf = 14 Cif = N7 Cib = 8 END IF '------------------------------------------------------------------------- ' Change the Cursor Shape Depending Upon Insert Mode ' Insert On is normal DOS Cursor; Overstrike is Full Solid Cursor ' The mono display adapter has lines 0 to 13, the color has 0 to 7 ' in the LOCATE statement for the cursor size OverstrikeCursorStart = N0 IF MonoCRT THEN InsertCursorStart = 12 ' Mono Cursor Defaults CursorStop = 13 ELSE InsertCursorStart = N6 ' Color Cursor Defaults CursorStop = N7 END IF CursorStart = InsertCursorStart CursorState = N0 '------------------------------------------------------------------------- CALL SaveDOSKeyState ' Save DOS keys and page UserSaved = No ' Reset user screen saved flag CALL SetVideoMode(N0) ' Change to Text Mode if not there CALL SetVideoPage(N0) ' Change to Page Zero if not there '========================================================================= CALL Kolors(N6) CLS CALL BoxDraw(N2, N11, N15, N15, N64) Tag$ = " Please Wait--Personal Calendar is Initializing " CALL ShowIt(N17, N13, Nm2, Tag$) '------------------------------------------------------------------------- NewGuy = Yes IF ColorCRT THEN CALL ReadCalfig ' Read (or write) Color Choices END IF '========================================================================= MemoryResident = No ' Set non-zero once resident first time NumberofHotFKeys = 10 NumberofHotCKeys = 16 CALL ReadCalinit(N1) ' Fixed Array Initialization CALL SaveCurrentDirectory(N1) ' Get Calendar Directory '========================================================================= ' Stay Res Initialization -- Part 2 of 2 '========================================================================= ' This reads the CALRES.DAT file and sets all early options IF NOT DOS2x THEN CALL StayResInitialization(N1) END IF '========================================================================= ' Initialize Remaining Variables '========================================================================= ' Debugging Mode If Desired IF InString(COMMAND$, "DEBUG") THEN DebugRequested = Yes ELSE DebugRequested = No END IF AllowInsertMode = No DateFromDOS$ = DATE$ TodaysDate$ = MID$(DateFromDOS$, N7, 4) + MID$(DateFromDOS$, N1, N2) + _ MID$(DateFromDOS$, 4, N2) '========================================================================= AlarmMusicPlayed = Yes AlarmSet = No ApptFile = No ApptFilename$ = Blank8$ AutoMode$ = False$ Bsp = 8 CalendarColumns(N1) = N1 CalendarColumns(N2) = 25 CalendarColumns(N3) = 49 CalendarDate$ = TodaysDate$ CalendarStartRow = 8 CapsHold = N0 ClockPositionGraphic$ = CHR$(176) ' Dark-Screened Whole Character (°) ClockScreen = No ClockScreenPrint = No ClockSeparatorGraphic$ = CHR$(178) ' Light-Screened Whole Character (²) Column1 = N1 ' Columns for Clock Screen Column2 = 26 ' Instructions Column3 = 46 Column4 = 67 CopyFilename$ = Blank12$ CurrentEvent = N1 CurrentEventLine$ = Blank80$ CurrentNote = N1 CurrentNoteHist = N1 CursorColumn = N1 CursorRow = N1 Del = 83 DesiredCalendars$ = TodaysDate$ DirectReturn = No DownArrow$ = CHR$(25) ' Down-Arrow Character EarlyPopDownFailed = No East = 77 EchoSuppression = No EditPagesize = 20 EndKey = 79 Enter = 13 ErrorMessageToWrite = No Esc = 27 EventDate$ = SPACE$(8) EventTime$ = SPACE$(4) EventDateTime$ = SPACE$(12) EventPageCounter = N0 EventSizeCode$ = "e" ' Default 60 Events EventTableSize = 60 ' Default Number of Events EventTableStable = No EventYear$ = SPACE$(N2) ' Fix sizes of these variables EventMonth$ = EventYear$ ' so MhMidString can be used without EventDay$ = EventYear$ ' reassigning them later EventHour$ = EventYear$ EventMinute$ = EventYear$ EventLimRepeat$ = EventYear$ EventRepeat$ = SPACE$(N3) EventYear1st2$ = EventYear$ EventText$ = SPACE$(53) EventtoHistory = Yes F1 = 59 F2 = 60 F3 = 61 F4 = 62 F5 = 63 F6 = 64 F7 = 65 FirstTimeClock = Yes FirstTimeExecuted = Yes FooterAction$ = Blank1$ FooterRecall = No FooterSize = 5 ForceDate = No HighestValue# = 999999999999# ' High Long Value HomeKey = 71 InclHistory = No InclNotes = Yes InHelp = No InMenu = No Ins = 82 InterruptedLoop = No KeyCursor = 4 ' KeyStuff Functions KeyCursorOff = -4 KeyDelayedExit = No KeyNumOn = 5 KeyNumOff = N6 KeyShiftTrap = N0 KeyStatus = N1 KeyStatusAbs = 8 KeySingle = N2 KeyTimerInit = N7 KeyTrapEnabled = No KeyWait = N3 LeftArrow$ = CHR$(27) ' West-Arrow Character LimSep$ = Blank1$ LoopCounterShow = Yes MainMenuAuto = 10 MainMenuClock = N2 MainMenuColor = 13 MainMenuCopy = N7 MainMenuCreate = 4 MainMenuDate = 11 MainMenuDelete = 5 MainMenuDOS = 12 MainMenuHelp = 9 MainMenuList = N3 MainMenuOptions = 8 MainMenuPrint = N6 MainMenuRow = N7 MainMenuUse = N1 ' Main Menu Values MenuCancelled = N1 ' Menu Exit from ESC Key MenuEntryChosen = N0 ' Menu Exit from Enter Key MenuNormalExit = N0 ' Menu Exit from Enter Key MenuRecursiveReturn = No MenuRow = N7 MenuSize = N0 MenuSpecialExit = N0 ' Menu Exit other than Escape MovingClockTick$ = CHR$(4) ' Diamond () NoHistEndDefault = No NormalCalendars = Yes North = 72 NoteSize = N2 NoteSizeCode$ = "e" ' Default 60 Notes NullEvent$ = " - - :" + SPACE$(57) 'Null Event NullEventOld$ = " - - :" + SPACE$(58) NumberofEvents = EventTableSize NumberofNotes = 60 NumHold = N0 OldNumberEvents = NumberofEvents OldNumberNotes = NumberofNotes OnEditPage = No OnScreen = No OtherCalendars = No OverdueCount = N0 OverduePosition = N1 PathLegalChars$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890(){}@#$%^&!-_'~.\" PathLegalLength = LEN(PathLegalChars$) Pending = 5 PgDn = 81 PgUp = 73 PopWait = No PopWaitHold = No PrecursorChime$ = "mb o3 mn t55 l6" PrintedEventsScheduled = Nm1 PrinterLineCount = 1 PrinterLineLimit = 0 PrinterPause$ = False$ PrintingReport = No PrintorCopy$ = "p" Prnt = 42 RedisplayNotesEvents = Yes Rescheduling = No ReturnMessage$ = Blank0$ RightArrow$ = CHR$(26) ' East-Arrow Character ScreenSize = 20 ScrollingCalendars = No SoundLevel = 4 South = N80 SpecialExitAllowed = N1 ' Menu Special Exits Allowed SpecialExitDelete = N2 ' Menu Delete Key For Item Delete SpecialExitDisallowed = N0 ' Menu Special Exits Not Allowed SpecialExitEndKey = N7 ' Menu End Key For Last Page SpecialExitF2 = 5 ' Menu F2 For Event Resequencing SpecialExitHomeKey = N6 ' Menu Home Key For 1st Page SpecialExitInsert = N1 ' Menu Insert Key For Item Insertion SpecialExitPgDn = 4 ' Menu Page Up For Previous Page SpecialExitPgUp = N3 ' Menu Page Down For Next Page StartingHistory = N2 + NumberofEvents + NumberofNotes 'Default 12 StartingNote = N2 + NumberofEvents 'Default 62 StartupScreen = Yes StartupScreenHold = StartupScreen Tabb = 9 TextSize = LEN(EventText$) UpArrow$ = CHR$(24) ' Up-Arrow Character ValidSizes$ = "cdefghijklmnopq" ' 20 to 300 size codes WarningSet = No WeekBreak$ = True$ WeekendScheduling$ = False$ West = 75 WhichColor = N0 WhichEvent = N1 ZeroLine = Strng$(N80, N0) '========================================================================= CALL ReadCalinit(N2) ' Fixed Array Initialization '------------------------------------------------------------------------- ' Set Printer Array to None Selected PrinterCodes(1) = -99 '========================================================================= ' Set Printer Default '========================================================================= AvailablePrinters$ = "EIP4-" ' Epson, IBM, HPIIP/III, IBM4019, None SelectedPrinter$ = "-" ' Default to no initialization '========================================================================= FatalError = Yes PrimitiveState = No '========================================================================= ' Greeting Screens '========================================================================= CALL ClearScreenNormal(N0) '========================================================================= ' Enable Exiting Keys (Ctrl-Break and Ctrl-Esc) '========================================================================= ExitKeys = Yes '========================================================================= ' Greeting Screen 1 '========================================================================= CALL ReadCalser ' Get User Validation CALL GenGreetingScreen1 ' Display Startup Screen CALL KeyStuff(KeyStatusAbs) ' Display CAPS/NUML State First Time HardSnooze = No ' Allow keystroke-interrupted CALL Snooze(5!) ' Sleep for 5 seconds StartupScreenExit: StartupScreen = No StartupScreenHold = StartupScreen ' In case 1st popped down right away '========================================================================= CALL ReadCalauto ' Read (or write) Auto Startup File '------------------------------------------------------------------------- ' If User wants to be forced to set date & time IF ForceDate THEN CALL SetDateTime END IF '========================================================================= ' Greeting Screen 2 '========================================================================= CALL ClearScreenNormal(N1) CALL GenerateGreeting(N2) CALL DisplayApptFilename ' And Show Filename If It Exists '------------------------------------------------------------------------- ' Done Here So Greeting Is First IF (NewGuy = Yes OR UpdatingCalfig = Yes) AND ColorCRT THEN UpdatingCalfig = No CALL Snooze(0.7!) CALL PrepareforMessage CALL ShowIt(N0, N0, N0, _ " Created/Updated Color Choice File CALFIG.DAT") END IF '------------------------------------------------------------------------- IF NewGuy OR UpdatingCalres THEN CALL Snooze(0.7!) CALL PrepareforMessage CALL ShowIt(N0, N0, N0, _ " Created Memory-Resident Choice File CALRES.DAT") END IF '------------------------------------------------------------------------- IF UpdatingCalauto THEN CALL Snooze(0.7!) CALL PrepareforMessage CALL ShowIt(N0, N0, N0,_ " Created/Updated Automatic Startup File CALAUTO.DAT") UpdatingCalauto = No END IF '========================================================================= CALL ReadCalmusic ' Get Music Choices or Set Them '========================================================================= CALL ReadCalexcl ' Get History Exclusions or Set Them '========================================================================= CALL ReadCalDOS ' Get Prestored DOS Command or Set It '========================================================================= ' Test For Automatic Startup ' (Automatic Startup is Cancelled By an Early TSR Error) AutoStarted = No IF AutostartMode THEN AutoStarted = Yes Tag$ = " Please Wait -- " CALL ShowIt(N13, N11, Nm2, Tag$) Tag$ = " Automatic Startup Is In Progress " CALL ShowIt(N0, Nm2, Nm2, Tag$) IF SrAutoPopDown AND NOT SrAutoPopDownHappened THEN Tag$ = " ... and Automatic Pop Down Has Been Requested " CALL ShowIt(N0, - N3, Nm2, Tag$) END IF END IF IF MonoCRT THEN MainMenuLastEntry = 13 ELSE MainMenuLastEntry = 14 END IF '========================================================================= ' Get Rid of CALTODAY.DAT File If There (Not Used Any More) Tag$ = "caltoday.dat" CALL KillAFile(Tag$) '------------------------------------------------------------------------- GOSUB TodaysDateSet GOTO MainMenuEntry '------------------------------------------------------------------------- ' Today's Day Of Week, Date, and Time (Referenced After SetDateTime) TodaysDateSet: TodaysDate$ = MID$(DATE$, N7, 4) + MID$(DATE$, N1, N2) + _ MID$(DATE$, 4, N2) CALL DayDate(TodaysDate$) TodaysDay = IndexedDay CurrentTime$ = MID$(TIME$, N1, N2) + MID$(TIME$, 4, N2) + _ MID$(TIME$, N7, N2) CurrentDateTime$ = TodaysDate$ + MID$(CurrentTime$, N1, 4) CurrentDateTime# = VAL(CurrentDateTime$) RETURN '========================================================================= ' Main Menu Entry '========================================================================= MainMenuEntry: PrintingReport = No OnEditPage = No '------------------------------------------------------------------------- ' This Clears the Screen IF ErrorMessageToWrite THEN ' All Error Messages Are ' Shown Here Just Before CALL PrepareforFatal ' Return to Main Menu CALL ShowIt(N0, ErrMsgPlacement, N0, ErrorLine1$) CALL ShowIt(N0, Nm1, N0, ErrorLine2$) END IF '------------------------------------------------------------------------- IF NOT FirstTimeExecuted OR ErrorMessageToWrite THEN ErrorMessageToWrite = No ELSE FirstTimeExecuted = No END IF '------------------------------------------------------------------------- IF NewGuy THEN 'New User -- Wait 5-6 seconds, then go to help Tag$ = " Hello, new user. Help is on the way! -- " CALL ShowIt(N15, N15, Nm2, Tag$) CALL PlayStuff(Alarm$) ErrorSwitch = No CALL KeyStuff(KeyStatus) CALL Snooze(2.5!) CALL BlankFatal ' Kill Message after 2.5 seconds CALL Snooze(3!) GOTO HelpEntry ' Go to Help after 5.5 seconds END IF CreatingFile = No '------------------------------------------------------------------------- ' ApptFile Says Whether An Appointment File Is Open IF NOT EventTableStable THEN CALL CloseFiles END IF IF NOT AutoStarted THEN '-------------------------------------------------------------------- ' Menu Handler Uses MenuLines$ Array For Choice Lines, Maximum 20 '-------------------------------------------------------------------- MenuLines(N1) = "Use or Change an Existing Appointment File" MenuLines(N2) = "Clock and Calendar Alone" MenuLines(N3) = "Display a List of Saved Appointment Files" MenuLines(4) = "Create a New Appointment File" MenuLines(5) = "Delete Appointment File" MenuLines(N6) = "Print Appointment File" MenuLines(N7) = "Copy Appointments to an ASCII DOS File" MenuLines(8) = "Options for Appointment File" MenuLines(9) = "Help" IF NOT DOS2x THEN MenuLines(10) = _ "Memory-Resident (TSR Mode) Options and Automatic Startup" ELSE MenuLines(10) = "Automatic Startup" END IF MenuLines(11) = "Change DOS Date and Time" MenuLines(12) = "DOS Session or Command" MenuLines(13) = "Color Choices" ' Not On Monochrome Menu ' Because On Monochrome, This Entry Overlays the Color Choice Entry MenuLines(MainMenuLastEntry) = "Direct to the Clock Screen" END IF '------------------------------------------------------------------------- ' If Monochrome, No Color Change Choice ' If Not Returning To Menu From Other Screens, Last Choice Suppressed IF DirectReturn AND ApptFilename$ = Blank8$ THEN DirectReturn = No Menu1 = MainMenuUse END IF IF DirectReturn THEN MenuSize = MainMenuLastEntry ELSE MenuSize = MainMenuLastEntry - N1 END IF RedisplayCalendars = Yes IF AutoStarted THEN '-------------------------------------------------------------------- IF ApptFilename$ <> Blank8$ THEN MenuChoice = MainMenuLastEntry ' Auto Start With File Menu1 = MainMenuLastEntry GOTO AppointmentExistCheck ELSE MenuChoice = N2 ' Auto Start Without File Menu1 = MainMenuClock AutoStarted = No GOTO ProcessMenuChoice END IF END IF MainMenuRow = N7 GOSUB ClearFilenamePass GOTO GreetingShow '------------------------------------------------------------------------- ' Clear File Name and Password off Screen Before Menu is Generated ClearFilenamePass: CALL ShowMult(N6, N23, N1, N39, N2) RETURN '------------------------------------------------------------------------- GreetingShow: CALL GenerateGreeting(N3) ' Top of Main Menu Screen (3 line version) CALL ReturnLine CALL QuitLine IF NOT DOS2x THEN CALL PopLine CALL MenuDriver(MenuSize, Menu1, MainMenuRow, Nm1, No, N0, N0, N1) CALL ReturnLineDelete CALL QuitLineDelete IF NOT DOS2x THEN CALL PopLineDelete IF MenuExit = MenuCancelled THEN CALL EndItAll CALL BlankFatal '------------------------------------------------------------------------- ' Process Menu Choice '------------------------------------------------------------------------- ProcessMenuChoice: SELECT CASE Menu1 CASE MainMenuUse, MainMenuCreate TO MainMenuOptions ' Opens File GOTO StartAppointment CASE MainMenuClock GOTO ClockInitialize ' 2 = Clock/Calendar Only CASE MainMenuList CALL FileList ' 3 = Display Appointment Files CASE MainMenuHelp HelpEntry: CALL Help ' 9 = Help IF NewGuy THEN Menu1 = MainMenuCreate ' Set New Ones To Create NewGuy = No END IF CASE MainMenuAuto CALL AutoStart '10 = Automatic Startup CASE MainMenuDate CALL SetDateTime '11 = Change DOS Date/Time GOSUB TodaysDateSet ' and Associated Parameters CASE MainMenuDOS '12 = DOS Session CALL DOSShell(N0) ' and Return CASE 13, 14 '13/14 = Color Choices / Return ' Set Colors IF ColorCRT THEN IF Menu1 = MainMenuLastEntry - N1 THEN CALL SetColors GOTO MainMenuEntry END IF END IF ' Direct Return IF Menu1 = MainMenuLastEntry AND EventTableStable THEN GOTO EventEditStart END IF IF Menu1 = MainMenuLastEntry THEN GOTO AppointmentExistCheck ELSE GOTO StartAppointment END IF END SELECT GOTO MainMenuEntry '------------------------------------------------------------------------- ' All Functions That Request Access To Appointment File Start Here ' (Functions 1, 4, 5, 6, 7, 8 ' Use, Create, Delete, Print, Copy, Options) '------------------------------------------------------------------------- ' Skip File Name/Password Stuff If Already In Use ' 6 (Print), 7 (Copy), 8 (Options) StartAppointment: IF (Menu1 <= MainMenuDelete OR Menu1 >= MainMenuHelp) OR _ NOT DirectReturn THEN TimerSave! = TIMER InputResponse$ = ApptFilename$ Tag$ = "Appointment File Name" CALL ControlledInput(N23, N28, N23, N5, N8, Tag$, _ InputResponse$, N0, N1, N1, N1) IF Keystroke$ = CHR$(Esc) THEN CALL ClearScreenNormal(N1) AutoStarted = No GOTO MainMenuEntry END IF IF ApptFilename$ <> InputResponse$ THEN EventTableStable = No CALL CloseFiles END IF ApptFilename$ = InputResponse$ IF ApptFilename$ = Blank8$ THEN CALL FileList AutoStarted = No GOTO MainMenuEntry END IF END IF '========================================================================= ' Open Appointment File, New Or Otherwise AppointmentExistCheck: IF EventTableStable AND Menu1 <> MainMenuCreate THEN GOTO OptionsProcessing '------------------------------------------------------------------------- ' See if it is there ApptExists = FileExist(ApptFilename$ + ".cld") '========================================================================= ' If Existing On Create, A Mistake ' If Not Exists On Use, A Mistake IF Menu1 <> MainMenuCreate AND ApptExists THEN ' Open as Random and Proceed CALL OpenAppts ' Exists On Non-Create, Okay EventTableStable = No ApptFileStatus$ = "o" GOTO OptionsProcessing END IF '------------------------------------------------------------------------- IF Menu1 = MainMenuCreate AND NOT ApptExists THEN GOTO ReplaceFile ' Absent On Create, Okay END IF '========================================================================= ' Menu for Exists On Create or Non Exists On Use DirectReturn = No EventTableStable = No OnEditPage = No CALL MajorBeeper CALL ClearScreenNormal(N1) IF Menu1 <> MainMenuCreate THEN ScreenTitles$(N1) = "Non-Existent Appointment File" ELSE ScreenTitles$(N1) = "Appointment File Already Exists" END IF CALL Titles(N1) MenuLines(N1) = "Enter The File Name Again" MenuLines(N2) = "Display A List Of Saved Appointment Files" IF Menu1 <> MainMenuCreate THEN MenuLines(N3) = "Create A New Appointment File" ELSE MenuLines(N3) = _ "Wipe Out Existing Appointment File And Create New One" END IF IF Menu1 = MainMenuDelete THEN MenuSize = N2 ELSE MenuSize = N3 CALL MenuDriver(MenuSize, Menu2, MainMenuRow, Nm1, No, N0, N1, N1) CreatingFile = No CALL BlankFatal IF MenuExit = MenuCancelled THEN CALL ClearScreenNormal(N1) AutoStarted = No GOTO MainMenuEntry END IF SELECT CASE Menu2 CASE 1 ' Enter Name Again GOTO StartAppointment CASE 2 CALL FileList ' List of Existing Files GOTO MainMenuEntry CASE 3 ReplaceFile: IF Menu1 = MainMenuCreate THEN CLOSE Tag$ = ApptFilename$ + ".cld" CALL KillAFile(Tag$) END IF CALL OpenAppts ' Create A New Appointment File CreatingFile = Yes ' or Wiping Out Old And Creating New ApptFileStatus$ = False$ DirectReturn = Yes GOTO PasswordProcessing END SELECT '------------------------------------------------------------------------- 'File Format: 1 Master record with password and options ' Master record controls size of -- ' Default 60 Event records (NumberofEvents) ' Default 60 Note records (NumberofNotes) <-- pointed to ' By StartingNote ' unlimited History records <-- pointed to by StartingHistory OptionsProcessing: DirectReturn = Yes ' Get Options CALL GetOptions ' Be Extra Careful On File Deletion, Clobber Previous Password IF Menu1 = MainMenuDelete THEN EnteredPassword$ = Blank8$ GOTO PasswordProcessing END IF ' No Password on Repeats IF Menu1 > MainMenuDelete AND Menu1 < MainMenuHelp AND _ ApptFilename$ <> Blank8$ AND _ ApptPassword$ = EnteredPassword$ AND DirectReturn THEN GOTO PasswordCheck END IF IF EnteredPassword$ <> ApptPassword$ THEN GOTO PasswordProcessing IF Menu1 = MainMenuLastEntry OR ApptPassword$ = Blank8$ THEN GOTO PasswordCheck END IF '========================================================================= ' Appointment File Password PasswordProcessing: FOR I = N1 TO N2 IF I = N2 AND NOT CreatingFile THEN GOTO ApptFirstWrite IF I = N2 THEN CALL PrepareforMessage Tag$ = "Re-Enter Password To Confirm, Please" CALL ShowIt(N0, N0, N0, Tag$) END IF InputResponse$ = Blank8$ EchoSuppression = Yes IF NOT CreatingFile THEN CALL ScreenBottoms ELSE CALL ReturnLine CALL QuitLine END IF Tag$ = "Appointment File Password" CALL ControlledInput(N24, N28, N24, N1, N8, Tag$, InputResponse$, _ N0, N1, N0, N1) CALL ScreenBottomsDelete EchoSuppression = No IF Keystroke$ = CHR$(Esc) AND NOT CreatingFile THEN CALL ClearScreenNormal(N1) AutoStarted = No GOTO MainMenuEntry END IF IF I = N1 THEN PasswordHold$ = InputResponse$ NEXT I IF PasswordHold$ <> InputResponse$ THEN CALL MajorBeeper CALL Kolors(N14) CALL BlankError Tag$ = "Password Confirmation Doesn't Match -- Try Again" CALL ShowIt(N0, N0, N0, Tag$) GOTO PasswordProcessing END IF ApptFirstWrite: CreatingFile = No CALL Kolors(N6) CALL BlankFatal EnteredPassword$ = InputResponse$ IF ApptFileStatus$ <> "o" THEN ' If Not Old, Make New '==================================================================== ' New File, Clear Space For Master Record ApptPassword$ = EnteredPassword$ ' New Password CALL SetOptions ' Set Options ExitKeys = No CALL MhLset (ApptBuffer$, Blank80$) EventTableStable = No FOR I = N1 TO NumberofEvents CALL KeyStuff(KeyStatus) Var = N1 + I CALL PutApptRecord(Var) NEXT I FOR I = N1 TO NumberofNotes CALL KeyStuff(KeyStatus) Pointer = NumberofEvents + N1 + I CALL PutApptRecord(Pointer) NEXT I ExitKeys = Yes ApptFileStatus$ = "o" ELSE '=============================================================== ' Password Check PasswordCheck: IF EnteredPassword$ <> ApptPassword$ THEN ' Check Password, Delete File Or Read Table DirectReturn = No CALL PrepareforError Tag$ = "Password Invalid" CALL ShowIt(N0, N0, N0, Tag$) AutoStarted = No GOTO MainMenuEntry END IF END IF '========================================================================= ' Read Events '========================================================================= CALL ShowMult(N6, N23, N1, N40, N2) 'Clear File Name and Password Lines ' Delete File and Options Doesn't Need To Read Events (Wastes Time) IF Menu1 <> MainMenuOptions THEN IF Menu1 <> MainMenuDelete THEN IF NOT EventTableStable THEN ' WhichEvent Current Event Number ' EventPageCounter Current Event Page (0 to n) ' ApptBuffer$ File Buffer WhichEvent = N1 EventPageCounter = N0 CALL SetArrays ' Event/Note Array (re)set CALL SequenceEventsTable END IF ELSE '--------------------------------------------------------------- ' Delete File CALL CloseFiles Tag$ = ApptFilename$ + ".cld" CALL KillAFile(Tag$) OnEditPage = No CALL ClearScreenNormal(N1) CALL PrepareforMessage Tag$ = "File " + ApptFilename$ + " Successfully Deleted" CALL ShowIt(N0, N0, N0, Tag$) DirectReturn = No EventTableStable = No TimerSave! = TIMER ApptFilename$ = Blank8$ GOTO MainMenuEntry END IF '==================================================================== ' Print or Copy File PrintorCopy$ = False$ IF Menu1 = MainMenuPrint OR Menu1 = MainMenuCopy THEN ' Print File or Copy to DOS File IF Menu1 = MainMenuPrint THEN PrintorCopy$ = "p" ELSE PrintorCopy$ = "w" END IF CALL PrintCopy GOTO MainMenuEntry END IF ELSE ' Process Options CALL Options GOTO MainMenuEntry END IF ' Options IF Menu1 <> MainMenuLastEntry THEN '==================================================================== ' Opened File, Choice of Clock/Event/Note/History Displays MenuLines(N1) = MenuLines(MainMenuLastEntry) MenuLines(N2) = "Event Editing" MenuLines(N3) = "Note Editing" MenuLines(4) = "History Editing" OnEditPage = No CALL ClearScreenNormal(N1) ScreenTitles$(N1) = "Appointment File Usage" CALL Titles(N1) CALL MenuDriver(N4, MenuEditing, N6, Nm1, No, N0, N1, N1) IF MenuExit = MenuCancelled THEN CALL ClearScreenNormal(N1) Menu1 = MainMenuUse GOTO MainMenuEntry END IF SELECT CASE MenuEditing CASE 1 Menu1 = MainMenuLastEntry CASE 2 CASE 3, 4 IF MenuEditing = 3 THEN Tag$ = "N" ELSE Tag$ = "H" END IF CALL NotesHistory(Tag$) END SELECT END IF '========================================================================= ' Start Event Editing, Fill One-Screen Menu Array '========================================================================= EventEditStart: OnEditPage = No MenuSingleLine = No ResequenceEvents = No RedisplayNotesEvents = Yes IF Menu1 = MainMenuLastEntry THEN GOTO EventOverdueCleared END IF EventMenuFill: WhichEventSave = WhichEvent FOR JJ = N1 TO EditPagesize WhichEvent = JJ + EventPageCounter * EditPagesize CALL ApptToMenu(N1) MenuLines(JJ) = CurrentEventLine$ NEXT JJ WhichEvent = WhichEventSave ' Event Editing, Sort If Changed IF OnScreen THEN Label1$ = STR$(N1 + EventPageCounter * EditPagesize) Label2$ = STR$((EventPageCounter + N1) * EditPagesize) Label$ = "(" + RIGHT$(Label1$, LEN(Label1$) - N1) + Hyphen$ + _ RIGHT$(Label2$, LEN(Label2$) - N1) + ")" IF FooterSize >= N6 THEN CALL ShowIt(N3, F5HelpRow, N1, Blank8$) CALL ShowIt(N3, N17, N1, Blank80$) ' Clear Row Above Edit CALL ShowIt(N13, N0, N0, Label$) ' Print Event Label END IF EventScreen: IF NOT OnScreen OR OnScreenFirst THEN IF NOT MenuSingleLine AND NOT OnScreen THEN '--------------------------------------------------------------- ' Display Event Editing Full Screen CALL Kolors(N5) TimerDisplaySuppress = Yes CLS OnEditPage = Yes CALL Kolors(N19) Tag$ = "Repeat Date Day Time " + _ "Event (Page " + RIGHT$(STR$(EventPageCounter + _ N1), N2) + " Of " + RIGHT$(STR$(NumberofEvents \ N20), _ N2) + ")" + SPACE$(N25) CALL ShowIt(N0, N1, N1, Tag$) END IF FOR I = N1 TO N3 CALL ShowIt(N14, N21 + I, N1, EventInstructions1(I)) NEXT FOR I = N1 TO N3 CALL ShowIt(N9, N21 + I, N28, EventInstructions2(I)) NEXT CALL ShowIt(N0, N25, N1, EventInstructions3) FOR I = N1 TO N3 CALL ShowIt(N19, N21 + I, N50, EventNoteSharedIns(I)) NEXT OnScreenFirst = No END IF '------------------------------------------------------------------------- ' Accept Event Editing Choice '------------------------------------------------------------------------- EventMenuExit: MenuSpecialExit = SpecialExitAllowed'Allow Special Functions MenuEventEditing = WhichEvent - (EditPagesize * EventPageCounter) IF NOT OnScreen THEN MenuRow = N1 ELSE MenuRow = 17 EditingEvents = Yes CALL MenuDriver(EditPagesize, MenuEventEditing, MenuRow, N0, _ MenuSingleLine, MenuSpecialExit, N0, N0) EditingEvents = No WhichEvent = (EditPagesize * EventPageCounter) + MenuEventEditing MenuSingleLine = Yes ' Accept Choice SELECT CASE MenuSpecialExit CASE MenuNormalExit GOTO EventMenuCancel CASE SpecialExitF2 IF ResequenceEvents THEN GOTO EventMenuOut ELSE GOTO EventMenuError END IF CASE SpecialExitDelete ' Delete Event EventRepeat$ = "X " ResequenceEvents = Yes GOTO InDone CASE SpecialExitPgUp IF EventPageCounter = N0 THEN GOTO EventMenuError ELSE EventPageCounter = EventPageCounter - N1 END IF CASE SpecialExitPgDn IF EventPageCounter = (NumberofEvents \ EditPagesize - N1) THEN GOTO EventMenuError ELSE EventPageCounter = EventPageCounter + N1 END IF CASE SpecialExitHomeKey IF EventPageCounter = N0 THEN GOTO EventMenuError ELSE EventPageCounter = N0 END IF CASE SpecialExitEndKey IF EventPageCounter = (NumberofEvents \ EditPagesize - N1) THEN GOTO EventMenuError ELSE EventPageCounter = NumberofEvents \ EditPagesize - N1 END IF CASE ELSE ' Error, Try Again EventMenuError: CALL MinorBeeper GOTO EventMenuExit END SELECT '========================================================================= ' Reset Page Size and Event Number and Continue WhichEvent = (EditPagesize * EventPageCounter) + N1 MenuSingleLine = No GOTO EventMenuFill '------------------------------------------------------------------------- ' Cancel From Event Editing Resequences By Date/Time If Changed '------------------------------------------------------------------------- EventMenuCancel: IF MenuExit = MenuCancelled THEN EventMenuOut: MenuSingleLine = No CALL ClearOverdueTable ' Esc Sort Events EventOverdueCleared: IF ResequenceEvents OR OnScreen THEN IF NOT OnScreen THEN CALL Kolors(N5) ClearLimit = 4 ELSE ClearLimit = 8 Tag$ = SPACE$(N9) CALL ShowIt(N3, N17, N1, Tag$) END IF ScreenMultRow = 26 - ClearLimit CALL ShowMult(N0, ScreenMultRow, N1, N80, ClearLimit) END IF ' (Re)Sequence Events CALL SequenceEventsTable ' Display Calendar Flag IF ResequenceEvents THEN RedisplayCalendars = Yes ' Resequence In Place From F2 IF MenuSpecialExit = SpecialExitF2 THEN WhichEvent = N1 EventPageCounter = N0 OnScreenFirst = Yes GOTO EventEditStart END IF ' Reprint Bottom of Screen Instructions ' On Screen Returns Right To Clock Loop IF OnScreen THEN RefreshInstructions = Yes GOTO TimingLoopStart END IF CurrentEvent = N1 ' Off Screen Displays Whole Clock Page GOTO ClockInitialize END IF '========================================================================= ' Event An Event Line--Provide Instructions '========================================================================= CALL ApptToMenu(N1) ' Split Variables ' Bottom of Page Editing Instructions for ControlledInput FOR I = N1 TO 4 CALL ShowIt(N14, N21 + I, N34, EventInput(I)) NEXT '========================================================================= ' Edit An Event Line--Process Each Field EventFields: ResequenceEvents = Yes OnScreenFirst = Yes IF NOT OnScreen THEN BoxRow = MenuEventEditing + N1 ELSE BoxRow = MenuEventEditing + 17 END IF '------------------------------------------------------------------------- ' Before Editing, Write Previous (Non-Null) Record To History IF CurrentEventLine$ <> Blank80$ AND _ CurrentEventLine$ <> NullEvent$ THEN EventtoHistory = Yes HistoryBuffer$ = CurrentEventLine$ CALL WritetoHistory END IF ' To History '------------------------------------------------------------------------- '(Bi/Multi)Weekly/Daily/Monthly/Quarterly/Yearly Indicators (EventRepeat$) FieldRepeat: WhichEventField = N1 GOSUB InstructionFill GOTO RepeatIn ' Display Whatever Edit Instructions are Appropriate ' Along With Any Returned Error Message InstructionFill: FOR I = N1 TO 4 CALL ShowIt(N13, (N21 + I), N1, (EditInstructions(WhichEventField, I))) NEXT I CALL EventErrorMessage RETURN ' RepeatIn: CALL ControlledInput(BoxRow, N4, N1, N1, N3, Blank0$, EventRepeat$, _ N0, N0, N0, N0) ON InString(CHR$(Tabb) + CHR$(Esc) + CHR$(F1) + CHR$(Enter), _ RIGHT$(Keystroke$, N1)) GOTO FieldText, InDone, InDone, FieldLimRep '------------------------------------------------------------------------- ' Limited-Repeat Indicator (EventLimRepeat$) Only Shows ' If EventRepeat$ Has Something FieldLimRep: IF EventRepeat$ = SPACE$(N3) THEN EventLimRepeat$ = SPACE$(N2) ELSE ' Skip if Null WhichEventField = 8 GOSUB InstructionFill 'Instructions CALL ControlledInput(BoxRow, N1, N1, N1, N2, Blank0$, _ EventLimRepeat$, N1, N0, N0, N0) END IF ON InString(CHR$(Tabb) + CHR$(Esc) + CHR$(F1) + CHR$(Enter), _ RIGHT$(Keystroke$, N1)) GOTO FieldRepeat, InDone, InDone, FieldMonth '------------------------------------------------------------------------- ' Month (EventMonth$) FieldMonth: WhichEventField = N2 GOSUB InstructionFill 'Instructions CALL ControlledInput(BoxRow, N8, N1, N1, N2, Blank0$, EventMonth$, _ N1, N0, N0, N0) ON InString(CHR$(Tabb) + CHR$(Esc) + CHR$(F1) + CHR$(Enter), _ RIGHT$(Keystroke$, N1)) GOTO FieldLimRep, InDone, InDone, FieldDay '------------------------------------------------------------------------- ' Day (EventDay$) FieldDay: WhichEventField = 4 GOSUB InstructionFill 'Instructions CALL ControlledInput(BoxRow, N11, N1, N1, N2, Blank0$, EventDay$, _ N1, N0, N0, N0) ON InString(CHR$(Tabb) + CHR$(Esc) + CHR$(F1) + CHR$(Enter), _ RIGHT$(Keystroke$, N1)) GOTO FieldMonth, InDone, InDone, FieldYear '------------------------------------------------------------------------- ' Year (EventYear$) FieldYear: WhichEventField = 5 GOSUB InstructionFill 'Instructions CALL ControlledInput(BoxRow, N14, N1, N1, N2, Blank0$, EventYear$, _ N1, N0, N0, N0) IF EventYear$ = SPACE$(N2) THEN EventYear1st2$ = SPACE$(N2) ELSE ' First Two Digits of Year is Dependent on DOS Date ' Next Century if Last Two Is Before Last Two In DOS Date ' This Century if Last Two Is Equal/More Than Last Two In DOS Date ' (So the program doesn't have to be changed if it lives that long!) IF VAL(EventYear$) < VAL(MID$(TodaysDate$, N3, N2)) THEN EventYear1st2$ = RIGHT$(STR$(VAL(MID$(TodaysDate$, N1, N2)) _ + N1), N2) ELSE EventYear1st2$ = MID$(TodaysDate$, N1, N2) END IF END IF ON InString(CHR$(Tabb) + CHR$(Esc) + CHR$(F1) + CHR$(Enter), _ RIGHT$(Keystroke$, N1)) GOTO FieldDay, InDone, InDone, FieldHour '------------------------------------------------------------------------- ' Hour (EventHour$) FieldHour: WhichEventField = N6 GOSUB InstructionFill 'Instructions CALL ControlledInput(BoxRow, N21, N1, N1, N2, Blank0$, EventHour$, _ N1, N0, N0, N0) ON InString(CHR$(Tabb) + CHR$(Esc) + CHR$(F1) + CHR$(Enter), _ RIGHT$(Keystroke$, N1)) GOTO FieldYear, InDone, InDone, FieldMinute '------------------------------------------------------------------------- ' Minute (EventMinute$) FieldMinute: WhichEventField = N7 GOSUB InstructionFill 'Instructions CALL ControlledInput(BoxRow, N24, N1, N1, N2, Blank0$, EventMinute$, _ N1, N0, N0, N0) ON InString(CHR$(Tabb) + CHR$(Esc) + CHR$(F1) + CHR$(Enter), _ RIGHT$(Keystroke$, N1)) GOTO FieldHour, InDone, InDone, FieldText '------------------------------------------------------------------------- ' Text (EventText$) FieldText: WhichEventField = N3 GOSUB InstructionFill 'Instructions CALL ControlledInput(BoxRow, N28, N1, N1, TextSize, Blank0$, _ EventText$, N0, N0, N0, N1) ON InString(CHR$(Tabb) + CHR$(Esc) + CHR$(F1) + CHR$(Enter), _ RIGHT$(Keystroke$, N1)) GOTO FieldMinute, InDone, InDone, FieldRepeat GOTO FieldRepeat '========================================================================= ' Accept Change, Check The Date/Time And Redisplay The Results '========================================================================= ' Combine Date/Time, Check For Validity InDone: CALL CombineDateTime DateToValidate$ = EventDate$ + EventTime$ CALL CheckDate(DateToValidate$) IF DateValidation THEN CALL MajorBeeper GOTO FieldRepeat END IF DeleteEvent: CALL ValidateEventDate IF EventValidationError = N1 THEN CALL MajorBeeper GOTO EventFields END IF '------------------------------------------------------------------------- ' Repack Event Array For Menu And Rewrite Record In File CALL RepackApptRecord CALL BuildMenuLine MenuLines(MenuEventEditing) = CurrentEventLine$ CALL MhLset (ApptBuffer$, CurrentEventRecord$) Pointer = N1 + WhichEvent CALL PutApptRecord(Pointer) EventTableStable = No GOTO EventScreen '========================================================================= ' Display Clock Display--Displacement Different If File Open ClockInitialize: IF Menu1 = MainMenuClock THEN ApptFile = No ELSEIF EventTableStable THEN ApptFile = Yes END IF WholeClock = Yes OnEditPage = No RedisplayCalendars = Yes RefreshInstructions = Yes FromOverduePage = No ClockScreen = Yes ClockRow = N0 IF ApptFile THEN ClockColumn = 13 ELSE ClockColumn = N7 END IF CALL Kolors(N3) TimerDisplaySuppress = Yes CLS CALL KeyStuff(KeyStatusAbs) ' Calendar Offset IF ApptFile THEN CalendarStartColumn = 10 ELSE CalendarStartColumn = 5 END IF ' Event Display When Reprinting Time IF ApptFile THEN RedisplayNotesEvents = Yes Var1 = CalendarStartRow + N5 Var2 = N1 + CalendarStartColumn + CalendarColumns(N2) Tag$ = " (Computing Calendars) " CALL ShowIt(N14, Var1, Var2, Tag$) '------------------------------------------------------------------------- ' Change Condition Of Sound On Display IF ApptFile THEN X5 = N7 X6 = N0 ELSE X5 = 18 X6 = N3 END IF ScreenMultRow = X5 + N1 ScreenColumn = X6 + N1 CALL ShowMult(N6, ScreenMultRow, ScreenColumn, N6, N2) CALL ShowIt(N0, ScreenMultRow, N0, "Sound") GOSUB SoundDisplay GOTO FilenameDisplay SoundDisplay: CALL ShowIt(N6, (X5 + N2), (X6 + N1), (SoundLevels$(SoundLevel))) RETURN '------------------------------------------------------------------------- FilenameDisplay: IF ApptFile THEN '-------------------------------------------------------------------- ' Display File Name CALL GetFilenameLength Tag$ = MID$(ApptFilename$, N1, FilenameLength) + "'s" CALL ShowErase(N0, N1, N1, N10, Tag$) Tag$ = "Calendar" CALL ShowErase(N0, N2, N1, N10, Tag$) END IF '-------------------------------------------------------------------- ' Display Lines Of Clock FOR ClockLine = N1 TO N7 CALL KeyStuff(KeyStatus) ScreenRow = ClockRow + ClockLine ScreenColumn = ClockColumn + N2 SELECT CASE ClockLine CASE 1 CALL ShowIt(N10, N0, N0, (ClockGraphics(N1))) CASE 2, 6 CALL ShowIt(N3, N0, N0, (ClockGraphics(N2))) CASE 3 TO 5 CALL ShowIt(N3, N0, N0, (MID$(ClockGraphics(N2), _ N1, N1))) ScreenColumn = ClockColumn + 64 CALL ShowIt(N0, N0, N0, (MID$(ClockGraphics(N2), _ N1, N1))) CASE 7 CALL ShowIt(N10, N0, N0, (ClockGraphics(N3))) END SELECT NEXT ClockLine ' Display Box around Time, Same Color as Clock Foreground CALL Kolors(N3) CALL BoxDraw(N1, ClockRow% + N3, ClockRow% + N5, ClockColumn% + N4, _ ClockColumn% + N62) TimeBlock = Yes '========================================================================= ' BEGINNING OF ONE SECOND TIMING LOOP '========================================================================= ' Update The Time--Hold A Tight Loop Until Time Changes Seconds ' or until a keystroke is made ' Pop up date and time enabled if using appointment file -- only here!! TimingLoopStart: IF ApptFile THEN SrPopDateTime = Yes InterruptedLoop = No LoopCounter = N0 LoopCounterShow = No DO CurrentTimer$ = TIME$ IF DebugRequested THEN LoopCounter = LoopCounter + N1 END IF '--------------------------------------------------------------- CALL KeyStuff(KeySingle) IF LEN(Keystroke$) > N0 THEN InterruptedLoop = Yes LoopCounterShow = Yes GOTO TimingLoopEnd END IF LOOP WHILE CurrentTimer$ = PreviousTime$ LoopCounterShow = Yes PreviousTime$ = CurrentTimer$ '------------------------------------------------------------------------- IF ApptFile AND (EventsScheduled <> PrintedEventsScheduled OR _ WholeClock = Yes) THEN CALL ShowMult(N6, N4, N1, N9, N3) EventsScheduled$ = LTRIM$(RIGHT$(STR$(EventsScheduled), N3)) IF EventsScheduled = N0 THEN EventsScheduled$ = Noo$ CALL ShowIt(N6, N4, N2, EventsScheduled$) CALL ShowIt(N0, Nm1, N1, "Event") IF EventsScheduled <> N1 THEN CALL ShowIt(N0, N0, Nm1, "s") ELSE CALL ShowIt(N0, N0, Nm1, Blank1$) END IF CALL ShowIt(N0, Nm1, N1, "Scheduled") PrintedEventsScheduled = EventsScheduled End If '------------------------------------------------------------------------- CALL UpdateClockScreen '========================================================================= ' Sound The Alarm On An Overdue Event--Skip if Neither--Alarm Overrides '========================================================================= ' If Appointment File In Use, Then Check Alarm Table For Overdue Event IF ApptFile AND NOT AlarmSet THEN '-------------------------------------------------------------------- ' AlarmSet Is Set If Alarm Is To Ring WarningSet = No ' Reset SrPopTime# = HighestValue# FOR I = N1 TO NumberofEvents IF Alarms(I).Alarm <> 0# AND Alarms(I).Alarm < SrPopTime# THEN SrPopTime# = Alarms(I).Alarm END IF IF Alarms(I).Warning <> 0# AND _ Alarms(I).Warning < SrPopTime# THEN SrPopTime# = Alarms(I).Warning END IF IF Pending AND Alarms(I).Warning <> 0# AND _ Alarms(I).Warning <= CurrentDateTime# THEN WarningSet = Yes END IF ' Set Warning To Blink IF Alarms(I).Alarm <> 0# AND _ Alarms(I).Alarm <= CurrentDateTime# THEN AlarmSet = Yes END IF NEXT I IF SrPopTime# <> HighestValue# THEN SrPopDateTime = Yes ' Enable pop ELSE SrPopDateTime = No ' Else disable END IF END IF IF (AlarmSet OR WarningSet) AND ApptFile THEN ' If Alarm or Warning Was Found On First One, Check All Others Before ' Processing the Alarm IF SrAutoPopDown AND NOT SrAutoPopDownHappened THEN SrAutoPopDownHappened = Yes ' Kill AutoPop If Alarm or Warning END IF FOR JJ = N1 TO NumberofEvents CALL KeyStuff(KeyStatus) IF Pending AND Alarms(JJ).Warning <> 0# AND _ Alarms(JJ).Warning <= CurrentDateTime# THEN ' Skip Later WarningSet = Yes Alarms(JJ).Warning = 0# PendingEvents(JJ) = JJ END IF ' Set Warning To Blink IF Alarms(JJ).Alarm <> 0# AND _ Alarms(JJ).Alarm <= CurrentDateTime# THEN ' Later Entry Skip AlarmMusicPlayed = No AlarmSet = Yes ResequenceEvents = Yes RedisplayNotesEvents = Yes END IF ' Load Alarm NEXT JJ IF AlarmSet THEN WarningSet = No' Alarm Always Takes Precedence ' Play Music IF SoundLevel > N2 THEN CALL PlayAlarmWarning(WarningSet) ' Test for Alarm First IF AlarmSet THEN RedisplayCalendars = Yes ' Alarm May Change Calendars ' Reset Alarm Flag and Resort The Event Table After Alarm Rings AlarmSet = No SrPopDateTime = No ' Pop up date and time disabled CALL ProcessAlarm IF FromOverduePage THEN GOTO ClockInitialize END IF ELSE ' Force Footer Regeneration RedisplayNotesEvents = Yes FooterAction$ = "e" END IF END IF '========================================================================= ' On The Mark, Sound The Chimes IF NOT FirstTimeClock AND ChimeCount <> N0 AND _ CurrentMinute MOD 15 = N0 AND SoundLevel = 4 THEN ' Ring Chime IF CurrentMinute THEN PlayString$ = PrecursorChime$ + Strng$(ChimeCount, 67) ' "C" ELSE PlayString$ = Chime$ + PrecursorChime$ + Strng$(ChimeCount, 71) END IF ' "G" CALL PlayStuff(PlayString$) ErrorSwitch = No ChimeCount = N0 ' reset count END IF '========================================================================= ' All Over, Save Date, Timer, Hours, Minutes, Seconds ChimeCount = N0 PreviousDate$ = TodaysDate$ PreviousHour = CurrentHour PreviousMinute = CurrentMinute PreviousSecond = CurrentSecond PreviousQuarter = CurrentQuarter PrevQuarterPosition = CurrentHourPosition FirstTimeClock = No FooterAction$ = Blank1$ IF FooterRecall THEN 'Check Instruction Pop-Back Timer PopTimerNow! = FIX(TIMER) IF PopTimerNow! - PopTimerStart! = 10! THEN RedisplayNotesEvents = Yes RefreshInstructions = Yes FooterRecall = No END IF END IF '========================================================================= ' END OF ONE SECOND TIMING LOOP--ACCEPT A KEYSTROKE '========================================================================= ' Note: Pop-down is done in Sub KeyStuff, NOT Here! CALL KeyStuff(KeySingle) ' Place Caplock and Numlock on screen if needed TimingLoopEnd: AutoStarted = No SELECT CASE (LEN(Keystroke$) + N1) CASE 1 ' No Keystroke GOTO EndOfKeys CASE 2 ' Length One Keys GOTO ClockScreenKey CASE 3 ' Length Two Keys GOTO TwoByteKey END SELECT '========================================================================= ' Length One Keys--Print, Letters, Escape, and Del (Numlocked is .) ' and End (Numlocked is 1) ' and West (Numlocked is 4) ' and East (Numlocked is 6) ' and North (Numlocked is 8) ' and South (Numlocked is 2) ' and PgUp (Numlocked is 9) ' and PgDn (Numlocked is 3) ClockScreenKey: SELECT CASE InString(CHR$(Prnt) + "AaSsDdEeHhNn.1Tt468293" + CHR$(Esc), _ Keystroke$) '-------------------------------------------------------------------- CASE 1 ' Print Appointment File IF NOT ApptFile THEN GOTO BadKey ELSE ClockScreenPrint = Yes PrintorCopy$ = "p" CALL PrintCopy END IF '-------------------------------------------------------------------- CASE 2 TO 5 ' Set Sound (A or S, Does Not Matter) ' Level 1=Utterly Silent 2=Errors Only ' 3=Alarms 4=Chimes (Everything) IF ApptFile THEN SoundLevel = SoundLevel - N1 IF SoundLevel = N0 THEN SoundLevel = 4 ELSE IF SoundLevel <> 4 THEN SoundLevel = 4 ELSE SoundLevel = N1 END IF GOSUB SoundDisplay '-------------------------------------------------------------------- CASE 6, 7, 16, 17 ' Calendars ' Display Calendars For Different Date Or Return ' To Today's Calendars ' OtherCalendars$ Tells Which Calendar Footing '--------------------------------------------------------------- DateSpecific: IF InString("Dd", Keystroke$) = N0 AND _ NOT ScrollingCalendars THEN ' Return to Today ("T") Requested IF NormalCalendars THEN GOTO BadKey ' No Return If There OtherCalendars = No ' "D"ate Other NormalCalendars = Yes ' Normal Calendars CalendarDate$ = TodaysDate$ ELSE '--------------------------------------------------------------- ' Specific Date ("D") or Calendar Scrolling Requested OtherCalendars = Yes NormalCalendars = No ' Other Calendars '--------------------------------------------------------------- END IF '--------------------------------------------------------------- RedisplayNotesEvents = Yes ' All Calendars RefreshInstructions = Yes GOSUB HelpPromptKill TimeBlock = Yes IF NOT NormalCalendars AND NOT ScrollingCalendars THEN GOSUB BottomErase '---------------------------------------------------------- GetDate: RequestedCalendars$ = MID$(CalendarDate$, 5, 4) + _ MID$(CalendarDate$, 1, 4) CALL ControlledInput(N25, N50, N25, _ N17, N8, "Enter Desired Date (MMDDYYYY)", _ RequestedCalendars$, N1, N0, N0, N1) DesiredCalendars$ = MID$(RequestedCalendars$, 5, 4) + _ MID$(RequestedCalendars$, N1, 4) IF RequestedCalendars$ = Blank8$ THEN CALL MajorBeeper GOTO GetDate END IF DateToValidate$ = DesiredCalendars$ + SPACE$(4) CALL CheckDate(DateToValidate$) IF DateValidation THEN CALL MajorBeeper GOTO GetDate END IF '--------------------------------------------------------------- CalendarDate$ = DesiredCalendars$'Other Calendars END IF '--------------------------------------------------------------- ' Normal/Scroll Calendars Comes Here GOSUB BottomErase CALL ShowIt(N14, N25, Nm2, " (Computing) ") CALL PrintCalendar GOTO EndOfKeys ' BottomErase: CALL Kolors(N3) CALL ClearLast4 RETURN '=================================================================== CASE 8, 9 ' Edit Events (E) (File Open) or Use File (File Closed) ClockScreen = No Menu1 = MainMenuUse RedisplayCalendars = Yes IF ApptFile THEN ' Appt File Already Open--Edit EditPagesize = 20 OnScreen = No OnEditPage = No WhichEvent = N1 EventPageCounter = N0 GOTO EventEditStart END IF CALL DirectReturnCheck CALL ClearScreenNormal(N1) 'Return to Main Menu GOTO MainMenuEntry '-------------------------------------------------------------------- CASE 10, 11 ' H or h ' Change or View History (H) NotesorHistory$ = "H" GOTO GoNotes '-------------------------------------------------------------------- CASE 12, 13 ' Change or View Notes (N) NotesorHistory$ = "N" GoNotes: IF NOT ApptFile THEN GOTO BadKey EditPagesize = 20 OnScreen = No IF NotesorHistory$ = "H" AND _ LOF(FilenumAppt) \ N80 < StartingHistory THEN GOTO BadKey ELSE ClockScreen = No CALL NotesHistory(NotesorHistory$) GOTO ClockInitialize END IF '-------------------------------------------------------------------- CASE 14 ' . for Delete GOTO DelOverdue '-------------------------------------------------------------------- CASE 15 ' 1 for End GOTO PrinterPage '==================================================================== CASE 18, 19 ' Scrolling Calendars With Arrows ' Scrolling Calendars One Month at a Time With West or East ScrollCalendars: OtherCalendars = Yes ScrollingCalendars = Yes '--------------------------------------------------------------- ' Get Current Calendar Value and Set Day to First of the Month CalendarYear = VAL(MID$(CalendarDate$, N1, 4)) CalendarMonth = VAL(MID$(CalendarDate$, 5, N2)) '--------------------------------------------------------------- ' Test if Later (Right arrow or 6) or earlier (Left arrow or 4) IF InString(CHR$(West) + "4", RIGHT$(Keystroke$, N1)) THEN '---------------------------------------------------------- ' Left arrow means one month earlier CalendarMonth = CalendarMonth - N1 IF CalendarMonth = N0 THEN CalendarMonth = 12 CalendarYear = CalendarYear - N1 IF CalendarYear < N0 THEN CalendarYear = 9999 END IF ELSE '---------------------------------------------------------- ' Right arrow means one month later CalendarMonth = CalendarMonth + N1 IF CalendarMonth = 13 THEN CalendarMonth = N1 CalendarYear = CalendarYear + N1 IF CalendarYear > 9999 THEN CalendarYear = N0 END IF END IF '--------------------------------------------------------------- ' Now Put the CalendarDate Back Together and Generate Calendars CALL YearAdjust(CalendarYear, AdjustedYear$) CalendarDate$ = ZeroFill$(AdjustedYear$ + _ RIGHT$(STR$(CalendarMonth), N2) + "01") GOTO DateSpecific '-------------------------------------------------------------------- CASE 20 ' 8 for North GOTO ScrollNotesBack '-------------------------------------------------------------------- CASE 21 ' 2 for South GOTO ScrollNotesFore '-------------------------------------------------------------------- CASE 22 ' 9 for PgUp GOTO ScrollEventsFore '-------------------------------------------------------------------- CASE 23 ' 3 for PgDn GOTO ScrollEventsBack '-------------------------------------------------------------------- CASE 24 ' Escape Goes Back To Main Menu (Esc) Menu1 = MainMenuLastEntry ClockScreen = No CALL ClearScreenNormal(N1) EditPagesize = 20 MenuSingleLine = No OnScreen = No CALL ClearOverdueTable GOTO MainMenuEntry '-------------------------------------------------------------------- CASE ELSE ' Other Length One Keys GOTO BadKey '-------------------------------------------------------------------- END SELECT GOTO EndOfKeys ' Normal One-Length Key Exit '========================================================================= ' Length Two Keys--Scroll Events/Notes/Calendars, Delete Overdue,DOS,DOS ' PgUp,PgDn,North,South,Del,F3,F4,F5,End,East,West,F6,F7 '========================================================================= TwoByteKey: SELECT CASE InString(CHR$(PgUp) + CHR$(PgDn) + CHR$(North) + _ CHR$(South) + CHR$(Del) + CHR$(F3) + CHR$(F4) + CHR$(F5) + _ CHR$(EndKey) + CHR$(East) + CHR$(West) + CHR$(F6) + _ CHR$(F7), RIGHT$(Keystroke$, N1)) '-------------------------------------------------------------------- CASE 1 ' PgUp Previous Event Window ' Scroll Events Backwards Footer Minus Notes Minus Overdue ScrollEventsFore: IF CurrentEvent = N1 OR NOT ApptFile THEN GOTO BadKey FooterAction$ = "e" RedisplayNotesEvents = Yes IF CurrentEvent <= (FooterSize - NoteSize - OverdueCount) THEN CurrentEvent = N1 ELSE CurrentEvent = CurrentEvent - _ (FooterSize - NoteSize - OverdueCount) END IF '-------------------------------------------------------------------- CASE 2 ' PgUp Previous Event Window ' Scroll Events Forwards Footer Size Minus Notes Minus Overdue ScrollEventsBack: IF NOT ApptFile THEN GOTO BadKey FooterAction$ = "e" RedisplayNotesEvents = Yes IF (CurrentEvent + N2 * _ (FooterSize - NoteSize - OverdueCount)) <= _ NumberofEvents + N1 THEN CurrentEvent = CurrentEvent + _ (FooterSize - NoteSize - OverdueCount) ELSE CurrentEvent = NumberofEvents + N1 - _ (FooterSize - NoteSize - OverdueCount) CALL MinorBeeper END IF '-------------------------------------------------------------------- CASE 3 ' North Previous Note Window ' Scroll Notes Backwards Note Size ScrollNotesBack: IF NoteSize = N0 OR CurrentNote = N1 OR _ NOT ApptFile THEN GOTO BadKey FooterAction$ = False$ RedisplayNotesEvents = Yes IF CurrentNote <= NoteSize THEN CurrentNote = N1 ELSE CurrentNote = CurrentNote - NoteSize END IF '-------------------------------------------------------------------- CASE 4 ' South for Next Note Window ' Scroll Notes Forwards Note Size (south) ScrollNotesFore: IF NoteSize = N0 OR NOT ApptFile THEN GOTO BadKey FooterAction$ = False$ RedisplayNotesEvents = Yes IF (CurrentNote + N2 * (NoteSize)) <= _ NumberofNotes + N1 THEN CurrentNote = CurrentNote + NoteSize ELSE CurrentNote = NumberofNotes + N1 - NoteSize CALL MinorBeeper END IF '-------------------------------------------------------------------- CASE 5 ' Del for Clear Overdue Events ' Clear Overdue Event From Display If There DelOverdue: IF NOT ApptFile OR OverdueCount = N0 THEN GOTO BadKey RedisplayNotesEvents = Yes RefreshInstructions = Yes CALL ClearOverdueTable TimerSave! = TIMER CALL PrintCalendar '-------------------------------------------------------------------- CASE 6 ' F3 for On-Screen Events ' On-Screen Events (F3) -- Blocks of 4 IF NOT ApptFile THEN GOTO BadKey ClockScreen = Yes OnEditPage = No OnScreenFirst = Yes OnScreen = Yes Menu1 = MainMenuUse EditPagesize = 4 WhichEvent = N1 + _ EditPagesize * (CurrentEvent - N1) \ EditPagesize EventPageCounter = (WhichEvent - N1) \ EditPagesize GOSUB HelpPromptKill GOTO EventEditStart '-------------------------------------------------------------------- CASE 7 ' F4 for On-Screen Notes ' On-Screen Notes (F4) -- Blocks of 4 IF NOT ApptFile THEN GOTO BadKey CurrentNote = N1 + _ EditPagesize * (CurrentNote - N1) \ EditPagesize ClockScreen = Yes OnEditPage = No OnScreenFirst = Yes OnScreen = Yes Menu1 = MainMenuUse EditPagesize = 4 GOSUB HelpPromptKill CALL NotesHistory("N") '-------------------------------------------------------------------- CASE 8 ' F5 for Pop-Back ' Instruction Pop-Back for 10 Seconds or Key Pressed (F5) IF NOT ApptFile OR FooterSize < N6 THEN GOTO BadKey FooterRecall = Yes CALL Instructions 'Give Instructions PopTimerStart! = FIX(TIMER) 'Set 10-Second Timer PopTimerNow! = PopTimerStart! '-------------------------------------------------------------------- CASE 9 ' End for Page Eject ' Page Eject Printing Event File (End) PrinterPage: IF NOT ApptFile THEN GOTO BadKey CALL InitPrinter CALL PageEject IF LprintTerminate THEN LprintTerminate = No END IF '-------------------------------------------------------------------- CASE 10, 11 ' East/West Arrows for Scrolling GOTO ScrollCalendars '-------------------------------------------------------------------- CASE 12 ' F6 For DOS Shell CALL DOSShell(N1) GOTO ClockInitialize '-------------------------------------------------------------------- CASE 13 ' F7 For DOS Prestored Command CALL DOSShell(N2) GOTO ClockInitialize '-------------------------------------------------------------------- CASE ELSE ' Other Length Two Keystrokes GOTO BadKey '-------------------------------------------------------------------- END SELECT GOTO EndOfKeys ' Normal Two-Length Key Exit '========================================================================= ' Blank F5 Help if needed HelpPromptKill: IF FooterSize >= N6 THEN CALL ShowIt(N3, F5HelpRow, N1, Blank8$) RETURN '------------------------------------------------------------------------- ' Invalid Keystroke or Nothing To Do On Valid One '------------------------------------------------------------------------- BadKey: CALL MinorBeeper '========================================================================= ' Keystroke Processing Finished, Refresh Events And Start Loop Again '========================================================================= ' Refresh Events/Notes and Instructions If Required EndOfKeys: IF ApptFile AND RedisplayNotesEvents THEN CALL RefreshEventsNotes IF FromOverduePage THEN GOTO ClockInitialize END IF END IF IF RefreshInstructions THEN CALL Instructions '------------------------------------------------------------------------- ' Do the Sound Indicator If Necessary IF RedisplayNotesEvents OR TimeBlock THEN GOSUB SoundDisplay '------------------------------------------------------------------------- OnEditPage = No ClockScreen = Yes RedisplayNotesEvents = No TimeBlock = No ScrollingCalendars = No IF NOT InterruptedLoop THEN WholeClock = No IF SrAutoPopDown AND (AutoMode$ = True$) AND NOT SrAutoPopDownHappened _ AND NOT SrAutoPopDownReady THEN SrAutoPopDownReady = Yes END IF '========================================================================= ' Start The Timing Loop Over Again GOTO TimingLoopStart END SUB '========================================================================= ' This Procedure Exits ONLY Through a Trapped Error and Always Returns ' (except in primitive mode, which ends in the main program) '========================================================================= '======================== END OF CAL2.BAS ============================= '========================================================================