PROC aalarm:
    global sndname$(6,9)
    local r%,acb%,aactive%,astat%
    local k%(2),kstat%,kactive%
    local t1&,t2&,snd$(8)  rem keep together
    local m$(20),ztsm$(22)
    local dat&,tim&,atype%
    local stype%
    local warning&
    initsns:
    r%=ioopen(acb%,"ALM:",-1)
    if r% :raise r% :endif
    atype%=2
    stype%=1
    gBorder 4
    busy "Any key sets alarm"
    while 1
        if kactive%=0
            keya(kstat%,k%(1))
            kactive%=1
        endif
        iowait
        if aactive% and astat%<>-46
            aactive%=0
            giprint ""
            busy "Any key sets alarm"
            continue
        endif
        busy off
        if k%(1)=27
            giprint "Bye..."
            pause -30
            stop
        endif
        kactive%=0
        if aactive%
            iow(acb%,4,#0,#0)   rem cancel outstanding request
            iowaitstat astat%
            aactive%=0
            dInit "Edit alarm"
        else
            t2&=timenow&:+3600
            warning&=0
            m$="Don't forget!"
            dInit "Set alarm"
        endif
        dEdit m$,"Text message"
        crack:(addr(t2&),addr(dat&),addr(tim&))
        dDate dat&,"Date",days(day,month,year),days(31,12,2049)
        dTime tim&,"Time",0,0,datetosecs(1970,1,1,23,59,59)
        dLong warning&,"Advance time",0,10080
        dChoice atype%,"Alarm type","Date only,Time and date"
        dChoice stype%,"Sound","Rings,Chimes,Fanfare,Soft bells,Church bells,Silent"
        if dialog
            t2&=combine&:(addr(dat&),addr(tim&))
            t1&=t2&-warning&*60
            ztsm$=m$+chr$(0)
            bufcopy:(addr(snd$)-1,addr(sndname$(stype%)),10)
            ioa(acb%,atype%+9,astat%,t1&,#addr(ztsm$)+1)
            aactive%=1
            giprint "Alarm queued"
            busy "Any key edits alarm"
        else
            busy "Any key sets alarm"
        endif
    endwh
ENDP

PROC initsns:
    sndname$(1)=chr$(1)
    sndname$(2)=chr$(2)
    sndname$(3)="SYS$AL01"
    sndname$(4)="SYS$AL02"
    sndname$(5)="SYS$AL03"
    sndname$(6)=chr$(15)
ENDP

PROC bufcopy:(di%,si%,cx%)
    call($a1,0,cx%,0,si%,di%)   rem BufferCopy
ENDP

PROC timenow&:
REM returns LONG giving system time
    local ax%,bx%,cx%,dx%,si%,di%,st&
    ax%=$0200
    os($89,addr(ax%))   rem TimGetSystemTime
    pokew addr(st&),bx% :pokew addr(st&)+2,ax%
    return(st&)
ENDP

PROC crack:(ast%,adat%,atim%)
REM cracks system time into day-sec format
    local dat&,tim&
    local cx%,dx%
    cx%=peekw(ast%+2)
    dx%=peekw(ast%)
    call($0489,0,cx%,dx%,0,addr(dat&))  rem TimSystemTimeToDaySeconds
    pokel adat%,dat&
    pokel atim%,tim&
ENDP

PROC combine&:(adat%,atim%)
REM combines day-sec format into system time format
    return(86400.0*(peekl(adat%)-25567.0)+peekl(atim%))
ENDP