home *** CD-ROM | disk | FTP | other *** search
/ PDA Software Library / pdasoftwarelib.iso / PSION / UTILS / MULTITIM / MULTITIM.OPL < prev    next >
Encoding:
Text File  |  1996-01-10  |  39.9 KB  |  1,541 lines
  1.  
  2. Rem MultiTimer
  3. Rem ╕1995 Erik Johansen, ej@it.dtu.dk
  4.  
  5. REM TODO: Power off if not already on (How?) / Option to Wait ?
  6.  
  7. APP MultiTim
  8.     TYPE $1003 rem Change to $5003 to disallow shutdown from system screen/backup
  9.     EXT "mt"
  10.     ICON "\OPD\MultiTim.pic"
  11. ENDA
  12.  
  13. PROC Start:
  14.     global curfile$(128),needsav%
  15.     global def$(255,64)
  16.     global flags%(50),op$(50,8),par&(50),par$(50,64),val$(50,64)
  17.     global maxproc%,first%,last%,curact%
  18.     global nexttim&,msgtim&
  19.     global inpon%,inpval$(64),prompt$(30)
  20.     global timon%,tim%,timstat%
  21.     global almon%,alm%,almstat%
  22.     global sndon%,snd%,sndstat%,sndsta2%,vol%
  23.     global cnton%,cntmsg&
  24.     global sigi%,sigt%,sigs%,siga%
  25.     global bigfnt%,gcx%(3),gcy%(3),gcw%(3),off%(3),gg%(3),fld%
  26.     global cur%,con%
  27.     global lasttim&,fnt%,fnth%
  28.     global sah&,sad&,say&
  29.     global bop$(8),bpar&,bpar$(64),bflags%,bval$(64),bdef$(64)
  30.     global next$(64),errmsg$(64)
  31.     global s%
  32.     maxproc%=50
  33.     sigi%=1 :sigt%=2 :sigs%=4 :siga%=8
  34.     first%=1 :last%=0
  35.     gcx%(1)=  8 :gcy%(1)= 1 :gcw%(1)=245 :off%(1)=1  :gg%(1)=1
  36.     gcx%(2)=  5 :gcy%(2)=63 :gcw%(2)=190 :off%(2)=%a :gg%(2)=2
  37.     gcx%(3)=203 :gcy%(3)= 0 :gcw%(3)=207 :off%(3)=1  :gg%(3)=2
  38.     fld%=2 :cur%=off%(fld%)
  39.     vol%=1
  40.     lasttim&=999999999 :nexttim&=lasttim&
  41.     sah&=3600 :sad&=86400 :say&=31536000
  42.     defaultwin 1
  43.     statuswin on,2
  44.     gsetwin 0,0,415,160
  45.     giprint "MultiTimer is Shareware",0 :diaminit 1,"unre-","gistered","version"
  46.     call($138b) REM Unmark as active
  47.     bigfnt%=gloadfont("rom::sa37snd")
  48.     setname "-none-"
  49.     SysReq:(cmd$(3),cmd$(2)) rem open file
  50.     Handler:
  51. ENDP
  52.  
  53. PROC SysReq:(act$,file$) REM For system requests
  54.     if     act$="X" :if last%>first% :needsav%=2 :endif :Exit:  REM Close and Exit
  55.     elseif act$="C" :MkFile:(file$)     REM Create new file
  56.     elseif act$="O" :OpenFile:(file$,0) REM Open file
  57. else :giprint "Sysreq: '"+act$+"' '"+file$+"'"
  58.     endif
  59. ENDP
  60.  
  61. PROC Handler:
  62.     global a%(6),keyfun$(8)
  63.     local wrap%
  64.     while 1
  65.         if testevent or last%<first%
  66.             WaitIn::
  67.             onerr Error1
  68.             curact%=0 Rem Indicates Interactive (no process)
  69.             getevent a%()
  70.             if a%(1)<256
  71.                 if inpon% and fld%=1
  72.                     if a%(1)=8 REM Delete
  73.                         if inpval$<>""
  74.                             inpval$=left$(inpval$,len(inpval$)-1)
  75.                             print chr$(8);" ";chr$(8);
  76.                         endif
  77.                     elseif a%(1)=13 REM Enter
  78.                         par$(inpon%)=inpval$
  79.                         flags%(inpon%)=0 REM Set as ready to run
  80.                         PntP:(inpon%)
  81.                     else
  82.                         print chr$(a%(1));
  83.                         inpval$=inpval$+chr$(a%(1))
  84.                     endif
  85.                     continue
  86.                 elseif def$(a%(1))<>""
  87.                     NewProc:("Parse", def$(a%(1)))
  88.                     continue
  89.                 endif
  90.             endif
  91.             keyfun$="x"+hex$(a%(1))
  92.             @(keyfun$):
  93.             continue
  94.             Error1::
  95.             if err=-99 :errmsg$="No function defined" :else :errmsg$=err$(err) :endif
  96.             giprint errmsg$+"; '"+chr$(a%(1))+"' ("+keyfun$+")"
  97.         else
  98.             onerr Error2
  99.             wrap%=0
  100.             NextProc::
  101.             curact%=curact%+1
  102.             if curact%>last%
  103.                 curact%=first%-1
  104.                 wrap%=wrap%+1 :if wrap%>2 :goto WaitIn :endif
  105.                 goto NextProc
  106.             elseif flags%(curact%)
  107.                 goto NextProc 
  108.             endif
  109.             @(op$(curact%)):
  110.             continue
  111.             Error2::
  112.             if err=-99 :errmsg$="No function defined" :else :errmsg$=err$(err) :endif
  113.             if left$(op$(curact%),1)="x" :a%(1)=eval("$"+mid$(op$(curact%),2,len(op$(curact%))-1)) :else :a%(1)=256 :endif
  114.             if a%(1)>255 :elseif def$(a%(1))<>"" :SetProc:("Parse",&0,"",left$(def$(a%(1))+val$(curact%),64)) :continue :endif
  115.             if a%(1)>255
  116.                 giprint errmsg$+" ("+op$(curact%)+")"
  117.             else
  118.                 giprint errmsg$+" '"+chr$(a%(1))+"' ("+op$(curact%)+")"
  119.             endif
  120.             Parse:
  121.         endif
  122.     endwh
  123. ENDP
  124.  
  125. PROC Exit:
  126.     if needsav% :SaveFile:(curfile$) :endif
  127.     if sndon% :Sdone: :endif
  128.     if timon% :Tdone: :endif
  129.     if almon% :Adone: :endif
  130.     gunloadfont bigfnt%
  131.     STOP
  132. ENDP
  133.  
  134. PROC UseProc:
  135.     if curact%=0 :NewProc:("Parse","") :endif
  136. ENDP
  137.  
  138. PROC NewProc:(op$,val$)
  139.     curact%=0
  140.     SetProc:(op$,&0,"",val$)
  141. ENDP
  142.  
  143. PROC SetProc:(op$,par&,par$,val$)
  144.     if curact%=0
  145.         curact%=first%
  146.         while curact%<=last% and flags%(curact%)<>$dead
  147.             curact%=curact%+1
  148.         endwh
  149.         if curact%>last%
  150.             if last%+1>=maxproc%
  151.                 giprint "Too many simultaneous jobs"
  152.                 curact%=0
  153.                 return
  154.             endif
  155.             last%=last%+1
  156.         endif
  157.     endif
  158.     op$(curact%)=op$
  159.     flags%(curact%)=0
  160.     par&(curact%)=par&
  161.     par$(curact%)=par$
  162.     val$(curact%)=val$
  163.     PntP:(curact%)
  164. ENDP
  165.  
  166. PROC End:(id%)
  167.     local a%
  168.     if id%<first% or id%>last% :giprint "["+num$(id%,3)+"] No such process to End" :return :endif
  169.     if flags%(id%)=$dead :giprint "Double End:("+num$(id%,3)+")" :return :endif
  170.     if id%=timon% :Tdone: :endif
  171.     if id%=almon% :Adone: :endif
  172.     if id%=sndon% :Sdone: :endif
  173.     if id%=inpon% :Idone: :endif
  174.     if id%=cnton% :Cdone: :endif
  175.     flags%(id%)=$dead :par$(id%)="" :val$(id%)=""
  176.     if id%=last%
  177.         while last%>first% and flags%(last%)=$dead :last%=last%-1 :endwh
  178.         if flags%(last%)=$dead :last%=last%-1 :endif
  179.     endif
  180.     PntP:(id%)
  181. ENDP
  182.  
  183. PROC Tstart:
  184.     local stat%
  185.     if timon% :Tdone: :endif
  186.     if almon% :Adone: :endif
  187.     rem queue io timerequest
  188.     timon%=curact% :nexttim&=par&(curact%)
  189.     stat%=ioopen(tim%, "TIM:", 0) :if stat% :ShowErr:("ioopen TIM:",stat%) :endif
  190.     ioc(tim%, 2, timstat%, nexttim&, nexttim&)
  191.     Next:("Waiting until: "+par$(curact%))
  192. ENDP
  193.  
  194. PROC Astart:
  195.     local tims&(2),msg$(64),stat%
  196.     if timon% :Tdone: :endif
  197.     if almon% :Adone: :endif
  198.     rem queue io timerequest
  199.     almon%=curact% :nexttim&=par&(curact%)
  200.     stat%=ioopen(alm%, "ALM:", 0) :if stat% :ShowErr:("ioopen ALM:",stat%) :endif
  201.     msg$=par$(curact%)+chr$(0)
  202.     tims&(1)=nexttim& :tims&(2)=nexttim&
  203.     ioc(alm%, 2, almstat%, tims&(), #uadd(addr(msg$),1))
  204.     Next:("Next alarm: "+par$(curact%))
  205. ENDP
  206.  
  207. PROC Tdone:
  208.     timon%=0 :Next:("") :msgtim&=0 :nexttim&=lasttim&
  209.     iocancel(tim%) :iowaitstat timstat%
  210.     ioclose(tim%)
  211.     Sig:(sigt%)
  212. ENDP
  213.  
  214. PROC Adone:
  215.     almon%=0 :Next:("") :msgtim&=0 :nexttim&=lasttim&
  216.     iocancel(alm%) :iowaitstat almstat%
  217.     ioclose(alm%)
  218.     Sig:(siga%)
  219. ENDP
  220.  
  221. PROC Sdone:
  222.     local stat%
  223.     call($2086)
  224.     if snd% :stat% = ioclose(snd%) :snd%=0 :if stat% :giprint "ioclose SND: "+err$(stat%) :endif :endif
  225.     Sig:(sigs%)
  226.     op$(sndon%)="Parse"
  227.     sndon%=0
  228. ENDP
  229.  
  230. PROC Idone:
  231.     inpon%=0
  232.     Cursor:(1,0)
  233.     gat 8,29 :ggrey 2 :gfill 245,10,1 :if fld%=1 :con%=0 :endif
  234.     Sig:(sigi%)
  235. ENDP
  236.  
  237. PROC Cdone:
  238.     cnton%=0
  239. ENDP
  240.  
  241. PROC Kill:(job%)
  242.     local ch$(1)
  243.     if job%=0  REM nothing active - return without killing
  244.     elseif job%<first% or job%>last%
  245.         giprint "Nothing to kill"
  246.     else
  247.         End:(job%)
  248.         giprint "Job "+num$(job%,3)+" killed"
  249.     endif
  250. ENDP
  251.  
  252. PROC Parse:
  253.     local f%
  254.     if curact%
  255.         if val$(curact%)=""
  256.             End:(curact%)
  257.         else
  258.             SetProc:("x"+hex$(asc(val$(curact%))),&0,"",mid$(val$(curact%),2,len(val$(curact%))-1))
  259.         endif
  260.     endif
  261. ENDP
  262.  
  263. PROC MkFile:(reqfile$)
  264.     local file$(128),o%(6)
  265.     o%(1)=1 :o%(2)=6 :o%(3)=8 :o%(4)=8 :o%(5)=10 :o%(6)=0
  266.     file$=parse$(reqfile$,"LOC::M:\*.MT",o%())
  267.     if needsav% :SaveFile:(curfile$) :endif
  268.     trap create file$,A,func%,def$
  269.     if err
  270.         giprint "Cannot create '"+file$+"': "+err$(err)
  271.         return
  272.     endif
  273.     trap close
  274.     setname file$ :curfile$=file$
  275.     Defaults:
  276.     Repaint:
  277. ENDP
  278.  
  279. PROC Defaults:
  280.     fnt%=5 :fnth%=8
  281. ENDP
  282.  
  283. PROC OpenFile:(file$,merge%)
  284.     local n%,rec$(255),v&
  285.     if needsav%<>0 and not merge% :SaveFile:(curfile$) :endif
  286.     trap open file$,A,func%,def$
  287.     if err :giprint "Cannot open '"+file$+"': "+err$(err) :return :endif
  288.     if merge%=0
  289.         setname file$ :curfile$=file$
  290.         n%=255 :while n% :def$(n%)="" :n%=n%-1 :endwh
  291.     endif
  292.     busy "Opening file"
  293.     Defaults:
  294.     first
  295.     while not eof
  296.         if a.func%>255
  297.             if merge%=0
  298.                 rec$=a.def$
  299. rem                pokew addr(v&),peekw(uadd(addr(rec$),1)) rem 4 byte-copy value
  300.                 Rem Unpack, start process
  301. Rem                NewProc:()
  302.                 giprint num$(count,5)
  303.                 erase :continue REM Erase process entry, now
  304.             endif
  305.         elseif def$(a.func%)<>a.def$
  306.             def$(a.func%)=a.def$ :needsav%=1
  307.         endif
  308.         next
  309.     endwh
  310.     busy off
  311.     trap close
  312.     Repaint:
  313. ENDP
  314.  
  315. PROC ShowErr:(txt$, stat%)
  316.     dinit
  317.     dtext "",txt$,$400
  318.     dtext "",err$(stat%),$600
  319.     dtext ""," "
  320.     dbuttons "Exit program",%x,"Continue",-13
  321.     lock on
  322.     if dialog:=%x :Exit: :endif
  323.     lock off
  324.     if curact% :Kill:(curact%) :endif
  325. ENDP
  326.  
  327. PROC ondisk:(ptr%)
  328.                             if exist(peek$(ptr%)) :return -1 :endif
  329.     pokeb uadd(ptr%,1),%a : if exist(peek$(ptr%)) :return -1 :endif
  330.     pokeb uadd(ptr%,1),%b : if exist(peek$(ptr%)) :return -1 :endif
  331. ENDP
  332.  
  333. PROC Repaint:
  334.     gupdate off
  335.     ggrey 2 :gcls :gborder $203 :con%=0
  336.     gfont 7 :gat 3,14 :gprint "MultiTimer ╕1995 Erik Johansen"
  337.     gat 3,40 :glineto 410,40 :gat 3,60 :glineto 410,60 :
  338.     gat 200,40 :glineto 200,155
  339.     gfont fnt%
  340.     gat   3,55 :gprintb "Function definitions",195,3
  341.     gat 203,55 :gprintb "Active jobs",200,3
  342.     Rem code for PntInp:
  343.     if inpon% :at 2,4 :print prompt$;inpval$; :endif
  344.     if fld%=1 :Cursor:(0,0) :endif
  345.     ZeroTim:
  346.     gat 8,18+fnth% :gprintb next$,250,2
  347.     PntDef:
  348.     PntPro:
  349.     gupdate on
  350. ENDP
  351.  
  352. PROC ZeroTim:
  353.     Big:("00:00:00")
  354. ENDP
  355.  
  356. PROC Big:(msg$)
  357.     gfont bigfnt% :gat 250,38 :gtmode 0 :gprintb msg$,150,1 :gfont fnt%
  358. ENDP
  359.  
  360. PROC PntDef:
  361.     local n%
  362.     n%=off%(2)
  363.     gupdate off :while PntD:(n%) :n%=n%+1 :endwh :gupdate off
  364. ENDP
  365.  
  366. PROC PntD:(n%)
  367.     local y%
  368.     if n%<off%(2) :return 1 :endif
  369.     y%=63+fnth%*(n%-off%(2)+1)-1
  370.     if y%>=155 :return 0 :endif
  371.     if fld%=2 and n%=cur% and con% :Cursor:(0,0) :endif Rem Unpaint
  372.     gat  5,y% :gprintb num$(n%,3),20,1
  373.     gat 25,y% :gprintb chr$(n%),20,3
  374.     gat 45,y%
  375.     if  n%>255
  376.         gprintb      "-",150,2
  377.     elseif def$(n%)=""
  378.         gprintb      "-",150,2
  379.     else
  380.         gprintb def$(n%),150,2
  381.     endif
  382.     if fld%=2 and n%=cur% :Cursor:(0,0) :endif Rem Paint again
  383.     return 1
  384. ENDP
  385.  
  386. PROC PntPro:
  387.     local n%
  388.     n%=off%(3)
  389.     gupdate off :while PntP:(n%) :n%=n%+1 :endwh :gupdate on
  390. ENDP
  391.  
  392. PROC PntP:(n%)
  393.     local y%,blank%
  394.     if n%<off%(3) :return 1 :endif
  395.     y%=63+fnth%*(n%-off%(3)+1)-1
  396.     if y%>=155 :return 0 :endif
  397.     if n%>last% :blank%=1 :elseif flags%(n%)=$dead :blank%=1 :endif
  398.     if fld%=3 and n%=cur% and con% :Cursor:(0,0) :endif
  399.     gat 201,y% :gprintb num$(n%,2),15,1
  400.     if blank%
  401.         gat 217,y% :gprintb "-",110,3
  402.         gat 327,y% :gprintb "-",33,3,0,0,5
  403.         gat 360,y% :gprintb "-",50,2,0,0,5
  404.     else
  405.         gat 217,y%
  406.         if     par$(n%)<>"":gprintb op$(n%)+" "+par$(n%),110,1
  407.         elseif op$(n%)<>"" :gprintb op$(n%),110,2
  408.         else               :gprintb     "-",110,3 :endif
  409.         
  410.         gat 327,y% :gprintb sig$:(flags%(n%)),33,3,0,0,5
  411.         
  412.         gat 360,y%
  413.         if     val$(n%)<>"" :gprintb val$(n%),50,2,0,0,5
  414.         else                :gprintb      "-",50,2,0,0,5 :endif
  415.     endif
  416.     if fld%=3 and n%=cur% :Cursor:(0,0) :endif
  417.     return 1
  418. ENDP
  419.  
  420. PROC Cursor:(udx%,udy%)
  421.     local dx%,dy%,ofld%,ox%,oy%,ow%,ooff%,og%
  422.     if     fld%=1 and udy%<>0 :dx%=udy% :dy%=udx%
  423.     elseif fld%=1 and udx%<>0 and inpon%<>0 REM Add text edit cursor movement here
  424.     else   :dx%=udx% :dy%=udy%
  425.     endif
  426.     ofld%=fld%
  427.     ox%=gcx%(fld%) :oy%=gcy%(fld%) :ow%=gcw%(fld%) :ooff%=off%(fld%) :og%=gg%(fld%)
  428.     fld%=fld%+dx% :if fld%<1 :fld%=1 :elseif fld%>3 :fld%=3 :endif
  429.     cur%=cur%-ooff%+off%(fld%)+dy% :if cur%<1 :cur%=1 :elseif cur%>255 :cur%=255 :endif
  430.     if fld%=3 and cur%>30 :cur%=30 :endif
  431.     if fld%=1 :gcy%(fld%)=39-fnth%
  432.     else      :gcy%(fld%)=oy%+dy%*fnth% :endif
  433.     if con% and (dx%<>0 or dy%<>0) :gat ox%,oy% :ggrey og% :ginvert ow%,fnth% :con%=1-con% :endif
  434.     if fld%>1 and (gcy%(fld%)<63 or gcy%(fld%)>155-fnth%)
  435.         if gcy%(fld%)<63 :gcy%(fld%)=63 :off%(fld%)=cur% :else :gcy%(fld%)=63+10*fnth% :off%(fld%)=cur%-10 :endif
  436.         if fld%=2 :PntDef: :else :PntPro: :endif
  437.         return
  438.     endif
  439.     gat gcx%(fld%),gcy%(fld%) :ggrey gg%(fld%) :ginvert gcw%(fld%),fnth% :con%=1-con%
  440.     ggrey 2
  441. ENDP
  442.  
  443. PROC RelTime$:(t&)
  444.     local res$(30),yr%,mo%,da%,ho%,mi%,se%,yrd%
  445.     secstodate t&,yr%,mo%,da%,ho%,mi%,se%,yrd%
  446.     ho%=abs(t&)/sah&
  447.     if ho%>23 :da%=int(ho%/24) :ho%=ho%-24*da% :res$=res$+num$(da%,5)+chr$(31) :endif
  448.     if ho%<10 :res$=res$+"0" :endif
  449.     res$=res$+num$(ho%,2)+":"
  450.     if mi%<10 :res$=res$+"0" :endif
  451.     res$=res$+num$(mi%,2)+":"
  452.     if se%<10 :res$=res$+"0" :endif
  453.     res$=res$+num$(se%,2)
  454.     return res$
  455. ENDP
  456.  
  457. PROC AbsTime$:(t&)
  458.     local res$(30),yr%,mo%,da%,ho%,mi%,se%,yrd%
  459.     secstodate abs(t&),yr%,mo%,da%,ho%,mi%,se%,yrd%
  460.     if da%<10 :res$=res$+" " :endif
  461.     res$=res$+num$(da%,2)+"/"+month$(mo%)+"/"+num$(yr%,4)+" "
  462.     if ho%<10 :res$=res$+"0" :endif
  463.     res$=res$+num$(ho%,2)+":"
  464.     if mi%<10 :res$=res$+"0" :endif
  465.     res$=res$+num$(mi%,2)+":"
  466.     if se%<10 :res$=res$+"0" :endif
  467.     res$=res$+num$(se%,2)
  468.     return res$
  469. ENDP
  470.  
  471. PROC RecED:
  472.     if     cur%<1000 :EDDef:(cur%)
  473.     else              EDPro:(cur%)
  474.     endif
  475. ENDP
  476.  
  477. PROC EDDef:(n%)
  478.     dinit "Definition for '"+chr$(n%)+"' ("+hex$(n%)+")"
  479.     dedit def$(n%),"",64
  480.     lock on
  481.     if dialog :PntD:(n%) :needsav%=1 :endif
  482.     lock off
  483. ENDP
  484.  
  485. PROC EDPro:(n%)
  486.     dinit "Process "+num$(n%,3)
  487.     dedit op$(n%),"Operation",64
  488.     dedit par$(n%),"Parameter",64
  489.     dtext num$(par&(n%),15),"Value",1
  490.     dedit val$(n%),"Next",64
  491.     lock on
  492.     if dialog :PntP:(n%) :endif
  493.     lock off
  494. ENDP
  495.  
  496.  
  497. PROC SaveFile:(file$)
  498.     local c%,fdef$(255,64)
  499.     if file$="" :return :endif
  500.     trap open file$,A,func%,def$
  501.     if err :trap create file$,A,func%,def$ :endif
  502.     if err
  503.         giprint "Cannot open '"+file$+"': "+err$(err)
  504.         return
  505.     endif
  506.     busy "Saving"
  507.     Rem Load current contents of file
  508.     first
  509.     while not eof
  510.         if a.func%>255 :erase :continue :endif REM Erase process entries
  511.         fdef$(a.func%)=a.def$
  512.         if a.def$<>def$(a.func%)
  513.             if def$(a.func%)=""
  514.                 erase
  515.             else
  516.                 a.def$=def$(a.func%) :fdef$(a.func%)=def$(a.func%)
  517.                 update :first
  518.             endif
  519.         else
  520.             next
  521.         endif
  522.     endwh
  523.     
  524.     c%=255
  525.     while c%
  526.         if fdef$(c%)="" and def$(c%)<>""
  527.             a.func%=c%
  528.             a.def$=def$(c%)
  529.             append
  530.         endif
  531.         c%=c%-1
  532.     endwh
  533.     if needsav%=2
  534.         busy "Saving (procs)"
  535.         c%=first%
  536.         while c%<=last%
  537.             a.func%=c%+256
  538.             rem flags%(50),op$(50,8),par&(50),par$(50,64),val$(50,64)
  539.             rem flags%() auto-regenerates and can be ignored
  540.             a.def$="    "+op$(c%)+chr$(0)+par$(c%)+chr$(0)+val$(c%) 
  541.             rem 0-3 par&()
  542.             rem op$(),par$(),val$() separated by chr$(0)
  543.             append
  544.             c%=c%+1
  545.         endwh
  546.     endif
  547.     trap close :if err<>0 and err<>-102 :giprint "Error closing file '"+file$+"': "+err$(err) :endif
  548.     busy off
  549.     giprint "Saved"
  550.     needsav%=0
  551. ENDP
  552.  
  553.  
  554. PROC Now&:
  555.     return datetosecs(year,month,day,hour,minute,second)
  556. ENDP
  557.  
  558. PROC Early&:(tim&)
  559.     return int(tim&/sad&)*sad&
  560. ENDP
  561.  
  562. PROC CopyBuf:(cut%)
  563.     rem Copy to paste buffer
  564.     if fld%=2
  565.         if def$(cur%)=""
  566.             if cut% :giprint "Nothing to remove" :else :giprint "Nothing to copy" :endif
  567.         else
  568.             bdef$=def$(cur%)
  569.             if cut% :giprint "Removed" :def$(cur%)="" :needsav%=1 :PntD:(cur%) :else :giprint "Copied" :endif
  570.         endif
  571.     elseif fld%=3
  572.         if cur%<first% or cur%>last%
  573.             if cut% :giprint "Nothing to remove" :else :giprint "Nothing to copy" :endif
  574.         else
  575.             bop$=op$(cur%)
  576.             bpar$=par$(cur%)
  577.             bpar&=par&(cur%)
  578.             bflags%=flags%(cur%)
  579.             bval$=val$(cur%)
  580.             if cut% :Kill:(cur%) :else :giprint "Copied" :endif
  581.         endif
  582.     endif
  583. ENDP
  584.  
  585. PROC Jump:
  586.     if inpon%=0
  587.         UseProc: :op$(curact%)="Jump" :PntP:(curact%)
  588.         Cursor:(-2,0)
  589.         inpon%=curact% :inpval$=""
  590.         at 2,4 :print "Press key to jump to: ";
  591.     elseif inpon%=curact%
  592.         if inpval$<>""
  593.             Idone:
  594.             Cursor:(0,asc(inpval$)-cur%)
  595.             Parse:
  596.         else
  597.             pause -5
  598.         endif
  599.     else
  600.         SigWait:(sigi%)
  601.     endif
  602. ENDP
  603.  
  604.  
  605.  
  606. PROC GetCh$:
  607.     if curact%<first% or curact%>last% :return "" :endif
  608.     if val$(curact%)="" :return "" :endif
  609.     return left$(val$(curact%),1)
  610. ENDP
  611.  
  612. PROC ChopCh$:
  613.     local len%
  614.     if curact%<first% or curact%>last% :return "" :endif
  615.     len%=len(val$(curact%))
  616.     if len% <= 1
  617.         val$(curact%)=""
  618.         return ""
  619.     else
  620.         val$(curact%)=mid$(val$(curact%),2,len%-1)
  621.         if val$(curact%)="" :return "" :endif
  622.         return left$(val$(curact%),1)
  623.     endif
  624. ENDP
  625.  
  626. PROC GetPara$:(func$,text$)
  627.     local param$(64),ch$(1),level%
  628.     if curact%<first% or curact%>last%
  629.         curact%=0 :if func$<>"" :SetProc:("Input", &0, text$, func$) :Input: :return chr$(0) :else :return "" :endif
  630.     endif
  631.     if inpon%=curact% :IDone: :return inpval$ :endif
  632.     ch$=GetCh$:
  633.     if ch$<>"(" and (ch$<"0" or ch$>"9")
  634.         if func$<>"" :SetProc:("Input", &0, text$, func$+val$(curact%)) :Input: :return chr$(0) :else :return "" :endif
  635.     endif
  636.     if ch$="(" :level%=level%+1 :ch$=ChopCh$: :endif
  637.     while ch$<>"" and (level%>0 or (ch$>="0" and ch$<="9"))
  638.         if ch$="("
  639.             level%=level%+1
  640.         elseif ch$=")"
  641.             level%=level%-1
  642.             if level%=0 :ch$=ChopCh$: :continue :endif
  643.         endif
  644.         param$=param$+ch$
  645.         ch$=ChopCh$:
  646.     endwh
  647.     return param$
  648. ENDP
  649.  
  650. Proc Sig$:(sig%)
  651.     local flags$(5)
  652.     if sig%=$dead :return "-" :endif
  653.     if sig% and sigi% :flags$=flags$+"I" :endif rem I
  654.     if sig% and sigt% :flags$=flags$+"T" :endif rem T
  655.     if sig% and sigs% :flags$=flags$+"S" :endif rem S
  656.     if sig% and siga% :flags$=flags$+"A" :endif rem T
  657.     return flags$
  658. ENDP
  659.  
  660. Proc Sig:(sig%)
  661.     local i%
  662.     if sig%=0 :return :endif
  663.     i%=first%
  664.     while i%<=last%
  665.         if flags%(i%) and sig%
  666.             flags%(i%)=0 :PntP:(i%)
  667.         endif
  668.         i%=i%+1
  669.     endwh
  670. ENDP
  671.  
  672. PROC SigWait:(sig%)
  673.     flags%(curact%)=sig%
  674.     PntP:(curact%)
  675. ENDP
  676.  
  677. PROC Input: rem Wait until input is free
  678.     UseProc:
  679.     if inpon%=0
  680.         gat 8,29 :ggrey 2 :gfill 245,10,1 :if fld%=1 :con%=0 :endif
  681.         prompt$=Par$(curact%)
  682.         at 2,4 :print prompt$;
  683.         Cursor:(-2,0)
  684.         inpon%=curact%
  685.         inpval$=""
  686.         Parse:
  687.     endif
  688.     SigWait:(sigi%)
  689. ENDP
  690.  
  691. PROC Wait:
  692.     local now&, dummy%
  693.     local yr%,mo%,da%,ho%,mi%,se%,yrd%,wd%
  694.     now& = Now&:
  695.     if Now& >= par&(curact%)
  696.         if timon%=curact% :ZeroTim: :Tdone: :endif
  697.         Parse:
  698.     elseif timon%=curact%
  699.         if now&=msgtim&
  700.             REM Determine number of 1/20 sec until next second
  701.             pause -5  Rem *1/20 sec pause - continue if keypress
  702.             now& = Now&:
  703.         endif
  704.         Big:(RelTime$:(par&(curact%)-Now&))
  705.         msgtim&=now&
  706.     elseif par&(curact%)<nexttim&
  707.         REM my alarm comes first, reset, and set to my time
  708.         Tstart:
  709.     else
  710.         SigWait:(sigt%+siga%) REM Make process wait until counter is free
  711.     endif
  712. ENDP
  713.  
  714. PROC Alarm:
  715.     local now&, dummy%
  716.     local yr%,mo%,da%,ho%,mi%,se%,yrd%,wd%
  717.     now& = Now&:
  718.     if Now& >= par&(curact%) and almon%=curact%
  719.         ioyield :ZeroTim:
  720.         if Now& > par&(curact%) REM Wait 2 sec
  721.             Adone:
  722.             Parse:
  723.         endif
  724.     elseif almon%=curact%
  725.         if now&=msgtim&
  726.             REM Determine number of 1/20 sec until next second
  727.             pause -5  Rem *1/20 sec pause - continue if keypress
  728.             now& = Now&:
  729.         endif
  730.         Big:(RelTime$:(par&(curact%)-Now&))
  731.         msgtim&=now&
  732.     elseif par&(curact%)<nexttim&
  733.         Astart: REM my alarm comes first, reset, and set to my time
  734.     else
  735.         SigWait:(sigt%+siga%) REM Make process wait until counter is free
  736.     endif
  737. ENDP
  738.  
  739. PROC Next:(msg$)
  740.     next$=msg$
  741.     gat 8,18+fnth% :gprintb next$,250,2
  742. ENDP
  743.  
  744. PROC Timer:
  745.     local now&,event%
  746.     if cnton%<>curact%
  747.         REM Another timer or request to stop timer
  748.         if left$(next$,5)="Timer" :Next:("") :endif
  749.         Parse:
  750.     elseif timon%<>0
  751.         SigWait:(sigt%)
  752.     elseif almon%<>0
  753.         SigWait:(siga%)
  754.     else
  755.         if left$(next$,5)<>"Timer" :Next:("Timer (started"+par$(curact%)+")") :endif
  756.         now& = Now&:
  757.         if now&=cntmsg&
  758.             rem event%=256 :ioc(-2,14,event%,0) :return
  759.             REM Determine number of 1/20 sec until next second
  760.             pause -5 Rem *1/20 sec pause - continue if keypress
  761.             now& = Now&:
  762.         endif
  763.         Big:(RelTime$:(Now&-par&(curact%)))
  764.         cntmsg&=now&
  765.     endif
  766. ENDP
  767.  
  768. PROC x8: rem Delete
  769.     if fld%=1 and inpon%<>0 and curact%=0
  770.         if inpval$<>""
  771.             inpval$=left$(inpval$,len(inpval$)-1)
  772.             print chr$(8);" ";chr$(8);
  773.         endif
  774.     elseif fld%>1
  775.         CopyBuf:(1)
  776.     endif
  777. ENDP
  778.  
  779. PROC x9: rem TAB = Jump to position
  780.     Jump:
  781. ENDP
  782.  
  783. PROC xd: rem ENTER = Edit current field (End input if inpon)
  784.     if inpon%
  785.         par$(inpon%)=inpval$
  786.         flags%(inpon%)=0 REM Set as ready to run
  787.         PntP:(inpon%)
  788.     else
  789.         RecED:
  790.     endif
  791. ENDP
  792.  
  793. PROC x1b: rem ESC = Cancel sound or background
  794.     if sndon%
  795.         Sdone:
  796.         giprint "Sound canceled"
  797.     else
  798.         call($198d,100,0)  Rem background
  799.     endif
  800.     Parse:
  801. ENDP
  802.  
  803. PROC x20: rem Space = No function (space in input)
  804.     if inpon%<>0 and curact%=0
  805.         print " ";
  806.         inpval$=inpval$+" "
  807.     else
  808.         Parse:
  809.     endif
  810. ENDP
  811.  
  812. PROC x22: rem " = text
  813.     local text$(64),ch$(1)
  814.     ch$=getch$:
  815.     while ch$<>"" and ch$<>"""" :text$=text$+ch$ :ch$=chopch$: :endwh
  816.     if ch$="""" :chopch$: :endif
  817.     giprint text$
  818.     Parse:
  819. ENDP
  820.  
  821. PROC x26: rem & = New process (fork&exec look alike)
  822.     local proc$(64)
  823.     proc$=getpara$:("&", "Commands: ") :if proc$=chr$(0) :return :endif
  824.     Parse:
  825.     if proc$<>"" :NewProc:("Parse", proc$) :Parse: :endif
  826. ENDP
  827.  
  828. PROC x41: rem A = Alarm
  829.     local param$(64),time$(64),mess$(64),t&,p%
  830.     param$ = GetPara$:("A","Alarm time,message: ") :if param$=chr$(0) :return :endif
  831.     UseProc:
  832.     if param$<>""
  833.         p%=loc(param$,",")
  834.         if p% :time$=left$(param$,p%-1) :mess$=right$(param$,len(param$)-p%) :else :time$=param$ :endif
  835.         t&=ParsTim&:(time$) :if t&=0 :End:(curact%) :return :endif
  836.         SetProc:("Alarm",t&,mess$,val$(curact%)) :Alarm:
  837.     endif
  838. ENDP
  839.  
  840. PROC x42: rem B = Beep (3-tone sound)
  841.     beep 1,300 :beep 1,200 :beep 1,300
  842.     Parse:
  843. ENDP
  844.  
  845. PROC x43: rem C = Countdown
  846.     local param$(64),stat%,pblk%(3)
  847.     param$=GetPara$:("C","Time,Delay,Cmd:")
  848.     if param$=chr$(0) :return
  849.     elseif param$<>"" :SetProc:("Cdown",&0,param$,val$(curact%)) :Cdown:
  850.     else
  851.         Parse:
  852.     endif
  853. ENDP
  854.  
  855. Proc CDown:
  856. ENDP
  857.  
  858. PROC x44: rem D = Dial phone number
  859.     local phon$(64),stat%,pblk%(3)
  860.     phon$=GetPara$:("D","Phone number:") :if phon$=chr$(0) :return :endif
  861.     if phon$<>""
  862.         stat% = ioopen(snd%, "SND:", 0) :if stat% :ShowErr:("ioopen SND:",stat%) :endif
  863.         pblk%(1)=5*256+4  rem Tone length *256 + delay length
  864.         pblk%(2)=32 rem Pause length
  865.         phon$=phon$+chr$(0)
  866.         stat% = iow(snd%, 10, #uadd(addr(phon$),1), pblk%()) :if stat% :ShowErr:("iow SND:",stat%) :endif
  867.         stat% = ioclose(snd%) :snd%=0 :if stat% :ShowErr:("ioclose SND:",stat%) :endif
  868.     endif
  869.     Parse:
  870. ENDP
  871.  
  872. PROC x4c: rem L - Listen for sounds
  873.     giprint "Listen (not impl.)"
  874.     Parse:
  875. ENDP
  876.  
  877. PROC x4d: rem M = Macro call (Tom Dolbilin)
  878.     local macro$(64),macsys$(20)
  879.     macro$=GetPara$:("M", "Macro:") :if macro$=chr$(0) or macro$="" :return :endif
  880.     macsys$="m:\app\macro.opa"
  881.     if not ondisk:(addr(macsys$)) :giprint macsys$+": Macro system not found." :return :endif
  882.     trap loadm macsys$ :if err :giprint macsys$+": "+err$(err) :return :endif
  883.     busy "Running macro '"+macro$+"'"
  884.     runmacro:(macro$, "macro")
  885.     busy off
  886.     unloadm macsys$
  887.     Parse:
  888. ENDP
  889.  
  890. PROC x4e: rem N = Note (play)
  891.     local notes$(64)
  892.     notes$=lower$(GetPara$:("N", "Notes to play:"))
  893.     if notes$=chr$(0)
  894.     elseif notes$<>""
  895.         SetProc:("Note",&0,notes$,val$(curact%)) :Note:
  896.     else
  897.         Parse:
  898.     endif
  899. ENDP
  900.  
  901. PROC Note:
  902.     local c$(1),tim%,tp%,n%,stat%,notes$(64),no%(130)
  903.     if sndon%=curact%
  904.         if sndstat%=-46
  905.             pause -5
  906.         else
  907.             if sndstat% :giprint err$(sndstat%) :endif
  908.             if sndsta2% :giprint err$(sndsta2%) :endif
  909.             Sdone:
  910.             Parse:
  911.         endif
  912.     elseif sndon%
  913.         SigWait:(sigs%) Rem Wait till sound device is free
  914.     else
  915.         sndon%=curact%
  916.         notes$=par$(curact%)
  917.         tim%=1 :tp%=0
  918.         while notes$<>""
  919.             c$=left$(notes$,1) :notes$=right$(notes$,len(notes$)-1)
  920.             if     c$>="0" and c$<="9"
  921.                 tim%=asc(c$)-48 :c$=left$(notes$,1)
  922.                 while c$>="0" and c$<="9" :tim%=tim%*10+asc(c$)-48 :notes$=right$(notes$,len(notes$)-1) :c$=left$(notes$,1) :endwh
  923.             elseif c$>="a" and c$<="z"
  924.                 n%=asc(c$)-96
  925.                 if n%>3 :n%=n%+1 :endif
  926.                 if n%>5 :n%=n%+1 :endif
  927.                 if n%>8 :n%=n%+1 :endif
  928.                 if n%>10 :n%=n%+1 :endif
  929.                 if n%>=12 :n%=n%+1 :endif
  930.                 rem n%=1..16 delay=512000/(freq=440*2**(n%/12.0))-1.0 & 440 Hz = middle A
  931.                 if tp%>=128 :giprint "Too many notes" :break :endif
  932.                 tp%=tp%+1 :no%(tp%)=440*2**(n%/12.0)
  933.                 tp%=tp%+1 :no%(tp%)=tim%
  934.             elseif c$=" "
  935.                 if tp%>=128 :giprint "Too many notes" :break :endif
  936.                 tp%=tp%+1 :no%(tp%)=0
  937.                 tp%=tp%+1 :no%(tp%)=tim%
  938.             elseif def$(asc(c$))<>""
  939.                 notes$=left$(def$(asc(c$))+notes$,64)
  940.             elseif c$<>"(" and c$<>")"
  941.                 giprint "N("+c$+") No such note"
  942.             endif
  943.         endwh
  944.         tp%=tp%/2
  945.         stat% = ioopen(snd%, "SND:", -1) :if stat% :giprint "ioopen SND: "+err$(stat%) :return :endif
  946.         ioc(snd%, 1, sndstat%, no%(), tp%)
  947.         ioc(snd%, 2, sndsta2%, no%(), tp%)
  948.     endif
  949. ENDP
  950.  
  951. PROC x4f: rem O = One-time sequence
  952.     x26: Rem Same functionality as & (fork/spawn)
  953. ENDP
  954.  
  955. PROC x50: rem P = Power off
  956.     Parse:
  957.     off
  958. ENDP
  959.  
  960. PROC x52: rem R = Repeat
  961.     local n%,rep$(64)
  962.     rep$=GetPara$:("","") :if rep$="" :giprint "No repeat count specified" :Parse: :return :endif
  963.     n%=val(rep$)-1
  964.     rep$=GetPara$:("","") :if rep$="" :giprint "No repeat operation specified" :Parse: :return :endif
  965.     if n%>=0
  966.         val$(curact%)=left$(rep$+"R"+num$(n%,5)+"("+rep$+")"+val$(curact%),64)
  967.         PntP:(curact%)
  968.     endif
  969.     Parse:
  970. ENDP
  971.  
  972. PROC x53: rem S = Sound file
  973.     local file$(64),oldin%,ticks&,p%
  974.     oldin%=inpon%
  975.     file$=GetPara$:("S", "File to play:") :if file$=chr$(0) :return :endif
  976.     if file$=""
  977.         Parse: Rem No input supplied
  978.     else
  979.         p%=loc(file$,",")
  980.         if p% :ticks&=val(right$(file$,len(file$)-p%)) :file$=left$(file$,p%-1) :else :ticks&=500 :endif
  981.         SetProc:("Sound",ticks&,file$,val$(curact%)) :Sound:
  982.     endif
  983. ENDP
  984.  
  985. PROC Sound:
  986.     local name$(128),ticks%
  987.     if sndon%=curact%
  988.         if sndstat%<>-46
  989.             Sdone: :Parse:
  990.         else
  991.             pause -5  REM Hang around until sound finishes
  992.         endif
  993.     elseif sndon%
  994.         SigWait:(sigs%) Rem Wait till sound device is free
  995.     else
  996.         sndon%=curact%
  997.         giprint "Playing sound file '"+par$(curact%)+"'"
  998.         name$=par$(curact%)
  999.         if name$>="1" and name$<="9" :name$="SYS$AL0"+name$ :endif
  1000.         if mid$(name$,3,1)<>":" :name$="*"+name$ :endif
  1001.         name$=name$+chr$(0)
  1002.         ticks%=par&(curact%)
  1003.         call($1E86,UADD(ADDR(name$),1),ticks%,vol%,0,addr(sndstat%))
  1004.     endif
  1005. ENDP
  1006.  
  1007. PROC x54: rem T = Timer (Count up)
  1008.     if cnton%
  1009.         Cdone:
  1010.         Parse:
  1011.     else
  1012.         UseProc:
  1013.         cnton%=curact%
  1014.         SetProc:("Timer",Now&:,"  "+right$(AbsTime$:(Now&:),8),val$(curact%)) :Timer:
  1015.     endif
  1016. ENDP
  1017.  
  1018. PROC x56: rem V = Volume
  1019.     local param$(64),c$(1),stat%,v%
  1020.     param$ = GetPara$:("V", "Volume control:") :if param$=chr$(0) :return :endif
  1021.     while param$<>""
  1022.         c$=left$(param$,1) :param$=right$(param$,len(param$)-1)
  1023.         if     c$>="0" and c$<="4"
  1024.             stat% = ioopen(snd%, "SND:", 0) :if stat% :giprint err$(stat%) :endif
  1025.             stat% = iow(snd%, 8, v%, v%) :if stat% :giprint err$(stat%) :endif
  1026.             vol%=53-asc(c$) :v%=(v% and $FF00) or vol%
  1027.             stat% = iow(snd%, 7, v%, v%) :if stat% :giprint err$(stat%) :endif
  1028.             stat% = ioclose(snd%) :snd%=0 :if stat% :giprint err$(stat%) :endif
  1029.         elseif c$="s" :call($108B,call($0f8b) or $8000)
  1030.         elseif c$="S" :call($108B,call($0f8b)and $7FFF)
  1031.         elseif c$="k" :call($108B,call($0f8b)and $FFFE)
  1032.         elseif c$="K" :call($108B,(call($0f8b)and $7FFF)or $1)
  1033.         elseif c$="b" :call($108B,call($0f8b)and $FFFD)
  1034.         elseif c$="B" :call($108B,(call($0f8b)and $7FFF)or $2)
  1035.         elseif c$="a" :call($108B,call($0f8b)and $FFFB)
  1036.         elseif c$="A" :call($108B,(call($0f8b)and $7FFF)or $4)
  1037.         elseif c$="c" :call($108B,call($0f8b)and $FFF7)
  1038.         elseif c$="C" :call($108B,(call($0f8b)and $7FFF)or $8)
  1039.         elseif c$="n" :call($108B,call($0f8b)and $FFEF)
  1040.         elseif c$="N" :call($108B,(call($0f8b)and $7FFF)or $10)
  1041.         else
  1042.             giprint "V("+c$+") No such option"
  1043.         endif
  1044.     endwh
  1045.     Parse:
  1046. ENDP
  1047.  
  1048. PROC x57: rem W = Wait
  1049.     local param$(64),t&,v$(64),oldin%
  1050.     oldin%=inpon%
  1051.     UseProc:
  1052.     if val$(curact%)=""
  1053.         param$ = GetPara$:("WB","Wait time: ")
  1054.     else
  1055.         param$ = GetPara$:("W","Wait time: ")
  1056.     endif
  1057.     if param$=chr$(0)
  1058.     elseif param$=""
  1059.         Parse:
  1060.     else
  1061.         t&=ParsTim&:(param$)
  1062.         if t&=0 :End:(curact%) :return :endif
  1063.         SetProc:("Wait",t&,AbsTime$:(t&),val$(curact%)) :Wait:
  1064.     endif
  1065. ENDP
  1066.  
  1067. PROC ParsTim&:(txt$)
  1068.     local t$(64),t&,f$(1),rt&
  1069.     local ws%,w%(8),ds%,d%(32),ys%,y%,n&,d%
  1070.     local yrspec%,mospec%,  daspec%,  wdspec%, hospec%,  mispec%,  sespec%
  1071.     local         mook%(12),daok%(33),wdok%(7),hook%(25),miok%(61),seok%(61)
  1072.     local yr%,mo%,da%,ho%,mi%,se%,yrd%,wd%
  1073.     t$=lower$(txt$) :f$=left$(t$,1)
  1074.     n&=0 :d%=0 :while f$>="0" and f$<="9" and t$<>"" :d%=d%+1 :n&=n&*10+asc(f$)-asc("0") :t$=mid$(t$,2,len(t$)-1) :f$=left$(t$,1) :endwh
  1075.     if d% and (f$="d" or f$="h" or f$="m" or f$="s" or f$="")
  1076.         while f$="d" or f$="h" or f$="m" or f$="s"
  1077.             if     f$="d" :t&=t&+n&*60*60*24 :t$=mid$(t$,2,len(t$)-1) :f$=left$(t$,1)
  1078.             elseif f$="h" :t&=t&+n&*60*60    :t$=mid$(t$,2,len(t$)-1) :f$=left$(t$,1)
  1079.             elseif f$="m" :t&=t&+n&*60       :t$=mid$(t$,2,len(t$)-1) :f$=left$(t$,1)
  1080.             elseif f$="s" :t&=t&+n&          :t$=mid$(t$,2,len(t$)-1) :f$=left$(t$,1)
  1081.             endif
  1082.             while f$=" " :t$=mid$(t$,2,len(t$)-1) :f$=left$(t$,1) :endwh
  1083.             n&=0 :d%=0 :while f$>="0" and f$<="9" and t$<>"" :d%=d%+1 :n&=n&*10+asc(f$)-asc("0") :t$=mid$(t$,2,len(t$)-1) :f$=left$(t$,1) :endwh
  1084.         endwh
  1085.         t&=t&+n&+Now&:
  1086.     else
  1087.         t&=Now&:
  1088.         rem mon-sun,jan-dec,dd/mm/yy,hh:mm:ss
  1089.         while t$<>""
  1090.             if f$="/"
  1091.                 t$=mid$(t$,2,len(t$)-1) :f$=left$(t$,1)
  1092.                 if n&>33 :print "Invalid Day" :return 0 :elseif d% :daspec%=1 :daok%(n&)=1 :endif
  1093.                 n&=0 :d%=0 :while f$>="0" and f$<="9" and t$<>"" :d%=d%+1 :n&=n&*10+asc(f$)-asc("0") :t$=mid$(t$,2,len(t$)-1) :f$=left$(t$,1) :endwh
  1094.                 if d%=0 and len(t$)>=3 :n&=Month:(left$(t$,3)) :if n& :t$=mid$(t$,4,len(t$)-3) :f$=left$(t$,1) :d%=1 :endif :endif
  1095.                 if n&>12 :print "Invalid Month" :return 0
  1096.                 elseif d% :mospec%=1 :mook%(n&)=1
  1097.                 endif
  1098.                 if f$="/" :t$=mid$(t$,2,len(t$)-1) :f$=left$(t$,1) :endif
  1099.                 n&=0 :d%=0 :while f$>="0" and f$<="9" and t$<>"" :d%=d%+1 :n&=n&*10+asc(f$)-asc("0") :t$=mid$(t$,2,len(t$)-1) :f$=left$(t$,1) :endwh
  1100.                 if d%
  1101.                     if n&<200 :n&=n&+1900 :endif
  1102.                     if n&<1970 or n&>2035 :print "Invalid Year "+num$(n&,4) :return 0
  1103.                     else :yrspec%=n&
  1104.                     endif
  1105.                 endif
  1106.                 n&=0 :d%=0
  1107.             elseif f$=":"
  1108.                 t$=mid$(t$,2,len(t$)-1) :f$=left$(t$,1)
  1109.                 if n&>24 :print "Invalid Hour" :return 0
  1110.                 elseif d% :hospec%=1 :hook%(n&+1)=1
  1111.                 endif
  1112.                 n&=0 :d%=0 :while f$>="0" and f$<="9" and t$<>"" :d%=d%+1 :n&=n&*10+asc(f$)-asc("0") :t$=mid$(t$,2,len(t$)-1) :f$=left$(t$,1) :endwh
  1113.                 if n&>60 :print "Invalid Minute" :return 0
  1114.                 elseif d% :mispec%=1 :miok%(n&+1)=1
  1115.                 endif
  1116.                 if f$=":" :t$=mid$(t$,2,len(t$)-1) :f$=left$(t$,1) :endif
  1117.                 n&=0 :d%=0 :while f$>="0" and f$<="9" and t$<>"" :d%=d%+1 :n&=n&*10+asc(f$)-asc("0") :t$=mid$(t$,2,len(t$)-1) :f$=left$(t$,1) :endwh
  1118.                 if n&>60 :print "Invalid Second" :return 0
  1119.                 elseif d% :sespec%=1 :seok%(n&+1)=1
  1120.                 endif
  1121.             elseif ((f$>="a" and f$<="z") or (f$>="A" and f$<="Z")) and len(t$)>=3
  1122.                 if Month:(left$(t$,3))
  1123.                     if n&>0 and n&<=31 :daspec%=1 :daok%(n&)=1 :endif
  1124.                     mospec%=1 :mook%(Month:(left$(t$,3)))=1
  1125.                     t$=mid$(t$,4,len(t$)-3) :f$=left$(t$,1)
  1126.                 elseif WDay:(left$(t$,3))
  1127.                     wdspec%=1 :wdok%(WDay:(left$(t$,3)))=1
  1128.                     t$=mid$(t$,4,len(t$)-3) :f$=left$(t$,1)
  1129.                 elseif left$(t$,3)="tom"
  1130.                     if len(t$)>=8 :t$=mid$(t$,9,len(t$)-8) :else :t$=mid$(t$,4,len(t$)-3) :endif
  1131.                     f$=left$(t$,1)
  1132.                     secstodate t&+sad&,yr%,mo%,da%,ho%,mi%,se%,yrd%
  1133.                     yrspec%=yr%
  1134.                     mospec%=1 :mook%(mo%)=1
  1135.                     daspec%=1 :daok%(da%)=1
  1136.                 else
  1137.                     giprint "'"+t$+"' not understood" :return 0
  1138.                 endif
  1139.             elseif f$=" "
  1140.                 t$=mid$(t$,2,len(t$)-1) :f$=left$(t$,1)
  1141.             else
  1142.                 giprint "'"+t$+"' not understood" :return 0
  1143.             endif
  1144.             n&=0 :d%=0 :while f$>="0" and f$<="9" and t$<>"" :d%=d%+1 :n&=n&*10+asc(f$)-asc("0") :t$=mid$(t$,2,len(t$)-1) :f$=left$(t$,1) :endwh
  1145.         endwh
  1146.         wd%=1
  1147.         secstodate t&,yr%,mo%,da%,ho%,mi%,se%,yrd%
  1148.         while 1
  1149.             if wdspec% :wd%=dow(da%,mo%,yr%) :endif
  1150.             if     yrspec%<>0 and yrspec%<yr%
  1151.                 giprint "Time cannot be matched" :return now&:
  1152.             elseif yrspec%>yr%
  1153.                 t&=t&-se%-60*mi%-sah&*ho%-sad&*(yrd%-1)+say&*(yrspec%-yr%)+sad&*int((yrspec%-yr%)/4)
  1154.                 secstodate t&,yr%,mo%,da%,ho%,mi%,se%,yrd%
  1155.                 while yr%<yrspec% REM in case of 366 days/year
  1156.                     t&=t&+sad&
  1157.                     secstodate t&,yr%,mo%,da%,ho%,mi%,se%,yrd%
  1158.                 endwh
  1159.             elseif mospec%<>0 and mook%(mo%)=0
  1160.                 t&=t&-se%-60*mi%-sah&*ho%-sad&*(da%-1)+sad&*33
  1161.                 secstodate t&,yr%,mo%,da%,ho%,mi%,se%,yrd%
  1162.                 t&=t&-sad&*(da%-1)
  1163.                 secstodate t&,yr%,mo%,da%,ho%,mi%,se%,yrd%
  1164.             elseif (daspec%<>0 and daok%(da%)=0) or (wdspec%<>0 and wdok%(wd%)=0)
  1165.                 t&=t&-se%-60*mi%-sah&*ho%+sad&
  1166.                 secstodate t&,yr%,mo%,da%,ho%,mi%,se%,yrd%
  1167.             elseif (hospec%<>0 and hook%(ho%+1)=0)
  1168.                 t&=t&-se%-60*mi%+sah&
  1169.                 secstodate t&,yr%,mo%,da%,ho%,mi%,se%,yrd%
  1170.             elseif (mispec%<>0 and miok%(mi%+1)=0)
  1171.                 t&=t&-se%+60
  1172.                 secstodate t&,yr%,mo%,da%,ho%,mi%,se%,yrd%
  1173.             elseif (sespec%<>0 and seok%(se%+1)=0)
  1174.                 t&=t&+1
  1175.                 secstodate t&,yr%,mo%,da%,ho%,mi%,se%,yrd%
  1176.             else
  1177.                 break
  1178.             endif
  1179.         endwh
  1180.     endif
  1181.     return t&
  1182. ENDP
  1183.  
  1184. PROC Month:(mnth$)
  1185.     local m$(3)
  1186.     m$=mnth$
  1187.     if     m$="jan" :return 1
  1188.     elseif m$="feb" :return 2
  1189.     elseif m$="mar" :return 3
  1190.     elseif m$="apr" :return 4
  1191.     elseif m$="may" :return 5
  1192.     elseif m$="jun" :return 6
  1193.     elseif m$="jul" :return 7
  1194.     elseif m$="aug" :return 8
  1195.     elseif m$="sep" :return 9
  1196.     elseif m$="oct" :return 10
  1197.     elseif m$="nov" :return 11
  1198.     elseif m$="dec" :return 12
  1199.     else               return 0
  1200.     endif
  1201. ENDP
  1202.  
  1203. PROC Wday:(weekday$)
  1204.     local day$(3)
  1205.     day$=weekday$
  1206.     if     day$="mon" :return 1
  1207.     elseif day$="tue" :return 2
  1208.     elseif day$="wed" :return 3
  1209.     elseif day$="thu" :return 4
  1210.     elseif day$="fri" :return 5
  1211.     elseif day$="sat" :return 6
  1212.     elseif day$="sun" :return 7
  1213.     else               return 0
  1214.     endif
  1215. ENDP
  1216.  
  1217. PROC x100: rem up
  1218.     if a%(2) and 2  rem Shift
  1219.         Cursor:(0,-2)
  1220.     elseif a%(2) and 4  rem Control
  1221.         Cursor:(0,-4)
  1222.     else
  1223.         Cursor:(0,-1)
  1224.     endif
  1225. ENDP
  1226.  
  1227. PROC x101: rem down
  1228.     if a%(2) and 2  rem Shift
  1229.         Cursor:(0,2)
  1230.     elseif a%(2) and 4  rem Control
  1231.         Cursor:(0,4)
  1232.     else
  1233.         Cursor:(0,1)
  1234.     endif
  1235. ENDP
  1236.  
  1237. PROC x102: rem right
  1238.     if a%(2) and 6  rem Shift or control
  1239.         Cursor:(2,0)
  1240.     else
  1241.         Cursor:(1,0)
  1242.     endif
  1243. ENDP
  1244.  
  1245. PROC x103: rem left
  1246.     if a%(2) and 6  rem Shift or control
  1247.         Cursor:(-2,0)
  1248.     else
  1249.         Cursor:(-1,0)
  1250.     endif
  1251. ENDP
  1252.  
  1253. PROC x104: rem Page up
  1254.     Cursor:(0,-20)
  1255. ENDP
  1256.  
  1257. PROC x105: rem Page down
  1258.     Cursor:(0,20)
  1259. ENDP
  1260.  
  1261. PROC x106: rem Home / Page left
  1262.     Cursor:(0,-255)
  1263. ENDP
  1264.  
  1265. PROC x107: rem End / Page right
  1266.     Cursor:(0,255)
  1267. ENDP
  1268.  
  1269. PROC x122: rem Menu
  1270.     local menu%
  1271.     onerr Error
  1272.     minit
  1273.     mcard "File","Open file",%o,"Merge file",%m,"New file",%n,"Save",%s,"Save as",%a,"Who did this?",%w,"Exit",%x
  1274.     mcard "Edit","Insert",%i,"Copy",%c,"Delete",%d,"Edit",%e
  1275.     mcard "Screen","Repaint",%r,"Jump to",%j
  1276.     lock on :menu% = MENU :lock off
  1277.     if menu%
  1278.         @("x"+hex$(menu%+$200)):
  1279.     endif
  1280.     return
  1281. Error::
  1282.     giprint "Menu function "+hex$(menu%+$200)+": "+err$(err)
  1283. ENDP
  1284.  
  1285. PROC x123: rem Help
  1286.     while 1
  1287.         onerr Missing
  1288.         dinit "Help"
  1289.         dtext "","Functions",$400
  1290.         dtext "","Parameters",$400
  1291.         lock on :s%=dialog :lock off
  1292.         if s% :@("Help"+num$(s%-1,1)): :else :return :endif
  1293.         continue
  1294.     Missing::
  1295.         giprint "Help missing ("+err$(err)+")"
  1296.     endwh
  1297. ENDP
  1298.  
  1299. PROC help1:
  1300.     while 1
  1301.         dinit "Functions 1/3"
  1302.         dtext "A(Time,Message)","Alarm (normal)"
  1303.         dtext "B","Beep (3 tone bleep)"
  1304. rem        dtext "C(Time,Sec,Delta)","Countdown"
  1305. rem to Time,beep every Delta sec, Sec seconds before time
  1306.         dtext "D(Phonenumber)","Dial phone number"
  1307. rem E - Every xx, for yy sec do zz
  1308.         dtext "M(Macro)","Call Tom Dolbilin's Macro system"
  1309.         dtext "N(Notes)","Play notes"
  1310.         dtext "O(Commands)","One-time sequence"
  1311.         lock on :s%=dialog :lock off :if s%=0 :return :endif
  1312.         dinit "Functions 2/3"
  1313.         dtext "P","Power off"
  1314.         dtext "Rn(Commands)","Repeat n times"
  1315.         dtext "S(Soundfile[,Ticks])","Play soundfile"
  1316.         dtext "V(Volume control)","Volume control"
  1317.         dtext "W(Time)","Wait for/until time"
  1318.         dtext "<function>","Call function definition"
  1319.         lock on :s%=dialog :lock off :if s%=0 :return :endif
  1320.         dinit "Functions 3/3"
  1321.         dtext """<text>""","Print text"
  1322.         dtext "&(Commands)","Create paralell process"
  1323.         dtext "<space>","Ignored"
  1324.         lock on :s%=dialog :lock off :if s%=0 :return :endif
  1325.     endwh
  1326. ENDP
  1327. PROC help2:
  1328.     while 1
  1329.         dinit "Parameters"
  1330.         dtext "","Time format",$400
  1331.         dtext "","Note parameters",$400
  1332.         dtext "","Volume parameters",$400
  1333.         lock on :s%=dialog :lock off
  1334.         if s% :@("Help2"+num$(s%-1,1)): :else :return :endif
  1335.     endwh
  1336. ENDP
  1337. PROC Help21:
  1338.     while 1
  1339.         dinit "Time format"
  1340.         dtext "","Absolute time",$400
  1341.         dtext "","Relative time",$400
  1342.         dtext "","Absolute and Relative times cannot be mixed"
  1343.         lock on :s%=dialog :lock off
  1344.         if s% :@("Help21"+num$(s%-1,1)): :else :return :endif
  1345.     endwh
  1346. ENDP
  1347. PROC Help211:
  1348.     dinit "Absolute Time"
  1349.     dtext "Any combination of"," "
  1350.     dtext "12:30:00","Time"
  1351.     dtext "1/jan/1995","Date"
  1352.     dtext "mon-sun, jan-dec","Weekdays, Months"
  1353.     dtext "Tomorrow","Tomorrow at 00:00:00"
  1354.     dtext "","Values in Date and Time can be left out to indicate"
  1355.     dtext "","only the wanted values. ie. 3/ is 3rd day of the month"
  1356.     dtext "","//1998 specifies only the year"
  1357.     lock on :dialog :lock off
  1358. ENDP
  1359. PROC Help212:
  1360.     dinit "Relative Time"
  1361.     dtext "","Relative times are specified as values plus optional multipliers"
  1362.     dtext "s","Seconds (default if no multiplier)"
  1363.     dtext "m","Minutes"
  1364.     dtext "h","Hours"
  1365.     dtext "d","Days"
  1366.     dtext ""," "
  1367.     dtext "Examples:","3h5m    2d5m   500   2h 5m   1h30m12s"
  1368.     lock on :dialog :lock off
  1369. ENDP
  1370. PROC Help22:
  1371.     dinit "Note parameters"
  1372.     dtext "<number>","Specifies note length in 1/20 seconds"
  1373.     dtext "a-z","Plays a note (based on 440hz middle tone)"
  1374.     dtext "<space>","Pause in note"
  1375.     dtext ""," "
  1376.     dtext "Example:","N(5a20z z z5a)"
  1377.     lock on :dialog :lock off
  1378. ENDP
  1379. PROC Help23:
  1380.     dinit "Volume parameters"
  1381.     dtext "1-5","Volume level"
  1382.     dtext "s/S","Sound system (all) on/off"
  1383.     dtext "K/B/A","Keyboard/Beep/Alarm sound on"
  1384.     dtext "k/b/a","Keyboard/Beep/Alarm sound off"
  1385.     dtext "c/C","Low/High Click (keyboard)"
  1386.     dtext "n/N","Low/High Notes (beep)"
  1387.     dtext ""," "
  1388.     dtext "Example:","V5   V(1k"
  1389.     lock on :dialog :lock off
  1390. ENDP
  1391.  
  1392. PROC x124: rem Star/diamond
  1393.     x277:
  1394. ENDP
  1395.  
  1396. PROC x263: rem psion-c = Copy
  1397.     CopyBuf:(0)
  1398. ENDP
  1399.  
  1400. PROC x264: rem psion-d = Delete Project/Entry
  1401.     x8: rem Delete
  1402. ENDP
  1403.  
  1404. PROC x265: rem psion-e = Edit
  1405.     RecED:
  1406. ENDP
  1407.  
  1408. PROC x269: rem psion-i = Insert
  1409.     local c%
  1410.     if fld%=2
  1411.         if bdef$=""
  1412.             giprint "Nothing to insert"
  1413.         else
  1414.             def$(cur%)=bdef$ :PntD:(cur%) :needsav%=1
  1415.         endif
  1416.     elseif fld%=3
  1417.         if bop$=""
  1418.             giprint "Nothing to insert"
  1419.         else
  1420.             c%=cur%
  1421.             if cur%<first% or cur%>last% :last%=last%+1 :c%=last% :endif
  1422.             op$(c%)=bop$
  1423.             par$(c%)=bpar$
  1424.             flags%(c%)=0 rem bflags%
  1425.             par&(c%)=bpar&
  1426.             val$(c%)=bval$
  1427.             PntP:(c%)
  1428.         endif
  1429.     endif
  1430. ENDP
  1431.  
  1432. PROC x26a: rem psion-j = Jump to
  1433.     Jump:
  1434. ENDP
  1435.  
  1436. PROC x261:  rem Save As
  1437.     local reqfile$(128),file$(128),ret%,o%(6)
  1438.     o%(1)=1 :o%(2)=6 :o%(3)=8 :o%(4)=8 :o%(5)=10 :o%(6)=0
  1439.     dinit "Save as"
  1440.     dfile reqfile$,"",$9
  1441.     lock on :ret%=dialog :lock off
  1442.     if ret%
  1443.         curfile$=parse$(reqfile$,"LOC::M:\*.MT",o%())
  1444.         SaveFile:(curfile$)
  1445.         setname curfile$
  1446.     endif
  1447. ENDP
  1448.  
  1449. PROC x26d: rem psion-m = Merge
  1450.     local file$(128),ret%
  1451.     dinit "Merge file"
  1452.     dfile file$,"",$10
  1453.     lock on :if dialog :OpenFile:(file$,1) :endif :lock off
  1454. ENDP
  1455.  
  1456. PROC x26E: rem psion-n = New file
  1457.     local file$(128),ret%
  1458.     dinit "Make new file"
  1459.     dfile file$,"",$9
  1460.     lock on :ret% = dialog :lock off
  1461.     if ret% :MkFile:(file$) :endif
  1462. ENDP
  1463.  
  1464. PROC x26f: rem psion-o = Open/Load
  1465.     local file$(128),ret%
  1466.     dinit "Open file"
  1467.     dfile file$,"",$10
  1468.     lock on :if dialog :OpenFile:(file$,0) :endif :lock off
  1469. ENDP
  1470.  
  1471. PROC x272:  rem psion-r - Repaint
  1472.     Repaint:
  1473. ENDP
  1474.  
  1475. PROC x273:  Rem Save
  1476.     SaveFile:(curfile$)
  1477. ENDP
  1478.  
  1479. PROC x277: rem psion-w = Who created this ? (whoinfo)
  1480.     dinit "MultiTimer"
  1481.     dtext "","Version 1.00",2
  1482.     dtext "","Created Sep 1995 - Dec 1995",2
  1483.     dtext "","by",2
  1484.     dtext "","Erik Johansen",$102
  1485.     dtext "","ej@it.dtu.dk",$102
  1486.     lock on :dialog :lock off
  1487.     dinit "MultiTimer is Shareware"
  1488.     dtext "","If you have decided to keep and use Multitimer",2
  1489.     dtext "","please send me $10 as shareware fee.",2
  1490.     dtext ""," "
  1491.     dtext "","Please include your name and E-mail address.",2
  1492.     dtext "","I will add you to my mailing list and send you",2
  1493.     dtext "","the newest registered version of MultiTimer.",2
  1494.     lock on :dialog :lock off
  1495.     dinit "So where do I send the money?"
  1496.     dtext "","Send $10 in your local currency to:"
  1497.     dtext "","(No coins, please)",2
  1498.     dtext ""," "
  1499.     dtext "","Erik Johansen",$102
  1500.     dtext "","Department of Information Technology",$102
  1501.     dtext "","DTU, building 344/345",$102
  1502.     dtext "","2800 Lyngby",$102
  1503.     dtext "","Denmark",$102
  1504.     lock on :dialog :lock off
  1505. ENDP
  1506.  
  1507. PROC x278: rem psion-x = Exit
  1508.     Exit:
  1509. ENDP
  1510.  
  1511. PROC x401: rem Foreground
  1512.     giprint "Press Psion-W for info",0
  1513. ENDP
  1514.  
  1515. PROC x402: rem Background
  1516. ENDP
  1517.  
  1518. PROC x403: rem Powerup
  1519.     Rem To enable wakeup (power on) signals
  1520.     Rem add the following call at start of
  1521.     Rem the program:  call($6c8d)
  1522.     Rem How come the signal comes in anyway ?
  1523.     x401:
  1524. ENDP
  1525.  
  1526. PROC x404: rem sys request
  1527.     local c$(129)
  1528.     c$ = getcmd$
  1529.     SysReq:(left$(c$,1),mid$(c$,2,128))
  1530. ENDP
  1531.  
  1532. PROC x405: rem Date change
  1533. ENDP
  1534.  
  1535. PROC x2000: rem + contrast
  1536. ENDP
  1537.  
  1538. PROC x2001: rem - contrast
  1539. ENDP
  1540.  
  1541.