'===========================================================================
' Subject: ALARM USING TSR                   Date: 01-28-99 (17:03)       
' Author:  Randall L. Glass                  Code: PB                     
' Origin:  rlglass@yahoo.com               Packet: PB.ABC
'===========================================================================
'                         Alarm
'                    By Randall L Glass
'                      Copyright 1998


'You may do anything you want with this program as long as you give me
'credit in the aknowledgments section of the program
'This program is as is.No claims are made for it


$dynamic
clear
x& = SETMEM(-550000)
declare function minutes&()
declare function day%()
ON ERROR GOTO errorhandling
AlarmTries%=0
gosub alarmtime
popdown:
popup key chr$(04,30,251)
popup sleep
trigger% = popup(4)
if trigger% <> 1 or errornumber% = 7 then goto checkminutes
input "filename";filein$
if filein$="" then print "no file name ":goto popdown
ext% = INSTR(filein$, ".")
IF ext% = 0 THEN filein$ = filein$ + ".bas"

enter$=chr$(13)
post& = 0
popup timer 1
stuffstring$ = "pwbasic" + enter$ + CHR$(27)+chr$(8)
GOSUB keyss
gosub stuffnothing


eofpointer% = 0
do
GOSUB getdata
enterpos&=0

do
oldenter&=enterpos&
enterpos&=instr(oldenter&+1,buffer$,enter$)
stuffstring$= mid$(buffer$,oldenter&+1,enterpos&-oldenter&)
GOSUB keyss
LOOP UNTIL enterpos&=bufferlength&
loop until eofpointer%
gosub stuffnothing
GOTO checkminutes

getdata:
OPEN filein$ FOR INPUT AS #1
SEEK #1, post&
buffer$=""
do
LINE INPUT #1, stuffstring$
stuffstring$ = ltrim$(stuffstring$,ANY " "+chr$(9))
buffer$ = buffer$+stuffstring$ + CHR$(13)
bufferlength&=len(buffer$)
loop until eof(1) or bufferlength& > 5000
eofpointer% = EOF(1)
post& = SEEK(1)
CLOSE #1
RETURN

keyss:
popup stuff stuffstring$,0,0

WaitForEmpty:
popup sleep
keybuffer% = POPUP(3)
IF keybuffer% < 256 THEN
GOTO WaitForEmpty
END IF
RETURN

gettime:
open "\time.dat" for input as #2
input #2,yesterday%
input #2,timeout2&
input #2,quittime&
input #2,lasttime&
input #2,AlarmTries%
close #2
if timeout2& > timeout& then timeout&=timeout2&
return

puttime:
open "\time.dat" for output as #3
today%=day%
lasttime&=minutes&
print #3,today%
print #3,timeout&
print #3,quittime&
print #3,lasttime&
print #3,Alarmtries%
close #3

return

errorhandling:
PRINT "error "; ERR
FOR i% = 1 TO 10
READ errorstring$, errornumber%
IF ERR = 7 then cls:print"OUT OF MEMORY !: Reboot ": stop
IF errornumber% = ERR THEN PRINT errorstring$: GOTO checkminutes
NEXT i%
PRINT ERR
resume popdown
DATA File Not Found,53,File Already Exists,58,Disk Full,61
DATA Bad File Name,64,Permission Denied,70,Disk Not Ready,71
DATA Disk Media Error,72,Rename Across Disks,74,Path File Access Error,75
DATA Path Not Found,76


checkminutes:
popup timer 10800
nowtime&=minutes&
if nowtime& > quittime& or alarmtries%=1 then gosub alarm
if nowtime& > timeout& and alarmtries% = 0 then gosub TakeBreak
goto popdown

function minutes&
minutes&=val(left$(time$,2))*60+val(mid$(time$,4,2))
end function

function day%
day%=val(mid$(date$,4,2))
end function



alarm:
x% = POS : y% = CSRLIN     'save cursor position and screen content
DEF SEG = &hB800: SaveScreen$ = PEEK$(0,4000)
width 40
CLS : LOCATE 9,14
print "TIME TO QUIT"
locate 12,7
if AlarmTries% = 0 then
print "This is your last Chance !"
else
print "I warned you so ..Freezing you out !
end if
k$=input$(1)
if AlarmTries% =1  then delay 86400
incr AlarmTries%
width 80
POKE$ 0, SaveScreen$ : LOCATE y%, x%       'restore old screen
def seg
return


TakeBreak:
timeout&=timeout&+10
x% = POS : y% = CSRLIN     'save cursor position and screen content
DEF SEG = &hB800 : SaveScreen$ = PEEK$(0,4000)
width 40
CLS : LOCATE 12,12
print "TIME TO TAKE A BREAK"
delay 600
timeout&=timeout&+50
width 80
POKE$ 0, SaveScreen$ : LOCATE y%, x%       'restore old screen
def seg
return

alarmtime:
today% = day%
gosub gettime
if yesterday% <> today% or minutes& > lasttime& + 50 then
gosub inputtime
end if
popup timer 1
return

inputtime:
print"What time do you want to quit (hh:mm) ";
print"[military time ";left$(time$,5);"]";
input ;quit$
quittime&=val(ltrim$(left$(quit$,2)))*60+val(mid$(quit$,4,2))
if ucase$(quit$)="NONE" then quittime&=99999
timeout&=minutes&+50
gosub puttime
return

stuffnothing:
stuffstring$=string$(4,13)+string$(35," ") + string$(215,0) +string$(2,13)
gosub keyss
return