home *** CD-ROM | disk | FTP | other *** search
/ PDA Software Library / pdasoftwarelib.iso / PSION / UTILS / WORKTIME / WORKTIME.OPL < prev    next >
Encoding:
Text File  |  1995-01-04  |  24.7 KB  |  1,129 lines
  1. APP WorkTime
  2.     TYPE $1003
  3.     EXT "WTM"
  4.     ICON "\OPD\Worktime.pic"
  5. ENDA
  6.  
  7. PROC Start:
  8.     global sad&,maxday&,d1970&,d2038&
  9.     global off&,exists%,cur&
  10.     global gcy%,gcmax%
  11.     global setup&(10)
  12.     global bmeet&,bleave&,bnormal&,bcomnt$(20)
  13.     global fonttyp%,zoom%,lines%,h%  Rem for zoomming
  14.     global prolist$(255)
  15.     Rem  --- Constants ---
  16.     sad&    = 86400 REM Seconds a day (24*60*60)
  17.     maxday& = 86399 REM 23:59:59
  18.     d1970&  = 25567 REM days(1,1,1970)
  19.     d2038&  = 50422 REM days(19,1,2038) Rem Not 100% correct, but closer than a Pentium ;-)
  20.     defaultwin 1
  21.     statuswin on,2
  22.     gsetwin 0,0,415,160
  23.     SysReq:(cmd$(3),cmd$(2)) rem open file
  24.     Handler:
  25. ENDP
  26.  
  27. PROC SysReq:(act$,file$) REM For system requests
  28.     SaveFile:
  29.     if act$="X"      rem Close and Exit
  30.         stop
  31.     elseif act$="C"  rem Create new file
  32.         MkFile:(file$)
  33.     elseif act$="O"  rem Open file
  34.         OpenFile:(file$)
  35.     endif
  36. ENDP
  37.  
  38. PROC SetFont:
  39.     local i%(32),font%
  40.     Rem
  41.     Rem Recalculate all font size dependent values
  42.     Rem
  43.     font%=fonttyp%+zoom%
  44.     setup&(10)=font%
  45.     gfont font%
  46.     font font%,0
  47.     ginfo i%()
  48.     h%=i%(3)
  49.     Rem TODO: Extract screen width
  50.     Rem TODO: and recalc column widths
  51.     lines%=(gheight-8)/h%
  52.     gcmax%=(lines%-1)*h%
  53.     off&=Offset&:(cur&,1-lines%) :gcy%=gcmax%
  54.     REM -- A repaint: is needed after this
  55. rem    cursor 1,1,255,h%,2 REM To bad max width is 255, really
  56. ENDP
  57.  
  58. PROC Handler:
  59.     global a%(6)
  60.     onerr Error
  61.     while 1
  62.         getevent a%()
  63.         @("x"+hex$(a%(1))):
  64.         continue
  65.         Rem    This part is only reached when no
  66.         Rem    corresponding event handler is found.
  67.         Rem    Keypresses fall back on either TextED: or RecED:
  68.     Error::
  69.         if err=-99 and a%(1)<256
  70.             if a%(1)>64 rem Textchars
  71.                 TextED:
  72.             else    Rem Other
  73.                 RecED:
  74.             endif
  75.         else
  76.             ShowErr:(hex$(a%(1)))
  77.         endif
  78.     endwh
  79. ENDP
  80.  
  81. PROC MkFile:(reqfile$)
  82.     local file$(128),o%(6)
  83.     o%(1)=1 :o%(2)=6 :o%(3)=8 :o%(4)=8 :o%(5)=10 :o%(6)=0
  84.     file$=parse$(reqfile$,"LOC::M:\*.WTM",o%())
  85.     trap create file$,A,meet&,leave&,normal&,total&,comment$
  86.     if err
  87.         ShowErr:("Cannot create '"+file$+"'")
  88.     else
  89.         append  rem Append empty entry
  90.         setname file$
  91.         setup&(1)=28800 REM 08:00:00 = 8*60*60 / Monday
  92.         setup&(2)=28800 REM 08:00:00 = 8*60*60 / Tuesday
  93.         setup&(3)=28800 REM 08:00:00 = 8*60*60 / Wedensday
  94.         setup&(4)=28800 REM 08:00:00 = 8*60*60 / Thursday
  95.         setup&(5)=18000 REM 05:00:00 = 5*60*60 / Friday
  96.         setup&(6)=0 rem Saturday
  97.         setup&(7)=0 rem Sunday
  98.         setup&(8)=0 rem Morning slack
  99.         setup&(9)=0 rem Evening slack
  100.         setup&(10)=9 :fonttyp%=9 :zoom%=0
  101.         cur&=Early&:(Now&:) :off&=cur&-lines%*sad& :gcy%=gcmax% :exists%=0
  102.         SetFont:
  103.         Repaint:
  104.     endif
  105. ENDP
  106.  
  107. PROC OpenFile:(file$)
  108.     local n%,sp%,set$(255),v$(10),sep$(1)
  109.     trap open file$,A,meet&,leave&,normal&,total&,comment$
  110.     if err
  111.         setname "-none-"
  112.         ShowErr:("Cannot open '"+file$+"'")
  113.         x26f: Rem As if user pressed Psion-O again to open file
  114.         return
  115.     endif
  116.     setname file$
  117.     Rem
  118.     Rem Comment string from first entry holds
  119.     Rem all the setup values.
  120.     Rem Extract and save as setup&(1-10)
  121.     Rem
  122.     set$=a.comment$
  123.     Rem Decide on what seperator was used
  124.     Rem for packing the setup values.
  125.     if loc(set$,chr$(13))
  126.         sep$=chr$(13)  Rem NEW setup
  127.     else
  128.         sep$=" "  Rem OLD setup
  129.     endif
  130.     n%=1 :sp%=loc(set$,sep$)
  131.     while sp%>0 and n%<=10
  132.         setup&(n%)=val(left$(set$,sp%-1))
  133.         if sp%>=len(set$) :break :endif
  134.         set$=right$(set$,len(set$)-sp%)
  135.         n%=n%+1 :sp%=loc(set$,sep$)
  136.     endwh
  137.     if sp% :prolist$=left$(set$,sp%-1) :endif
  138.     Rem reset if bad font value (happens when readng old format)
  139.     if setup&(10)<5 or setup&(10)>12
  140.         setup&(10)=9  
  141.         SaveSet: Rem update change
  142.     endif
  143.     fonttyp%=int(setup&(10)/4)*4+1
  144.     zoom%   =setup&(10)-fonttyp%
  145.     SetFont:
  146.     first :cur&=0 :MovTo:(datetosecs(year,month,day,23,59,59),1)
  147. ENDP
  148.  
  149. PROC ShowErr:(txt$)
  150.     dinit
  151.     dtext "",txt$,$400
  152.     dtext "",err$(err),$600
  153.     dtext ""," "
  154.     dbuttons "Exit program",%x,"Continue",-13
  155.     lock on
  156.     if dialog=%x :stop :endif
  157.     lock off
  158. ENDP
  159.  
  160. PROC Repaint:
  161.     ggrey 2 :gcls
  162.     Paint:(off&,lines%)
  163.     Cursor:
  164. ENDP
  165.  
  166. PROC Cursor:
  167.     gat 1,gcy%+4 :gfill 300,h%,2
  168. ENDP
  169.  
  170. PROC Paint:(from&,l%)
  171.     local y%,dy%,lin%
  172.     local yr%,mo%,da%,ho%,m%,s%,yrd%,wd%
  173.     local oldcur&,oldpos%,oldex%,oldcurd&
  174.     oldpos%=pos :oldcur&=cur& :oldex%=exists%
  175.     gborder $203
  176.     MovTo:(off&,0)
  177.     y%=MovCnt%:(from&,0)*h%
  178.     dy%  = h%*l%
  179.     ggrey 1
  180.     gat  90,y%+4 :glineby 0,dy%
  181.     gat 190,y%+4 :glineby 0,dy%
  182.     gat 240,y%+4 :glineby 0,dy%
  183.     gat 300,y%+4 :glineby 0,dy%
  184.     lin%=l%
  185.     while (lin%>0)
  186.         secstodate cur&,yr%,mo%,da%,ho%,m%,s%,yrd%
  187.         wd% = dow(da%,mo%,yr%)
  188.         ggrey 1 :gat 1,y%+4
  189.         if wd%=6 or wd%=7
  190.             gfill 300,h%,0
  191.         else
  192.             glineby 300,0
  193.         endif
  194.         ggrey 0
  195.         gat 7,y%+3
  196.         gmove 0,h% :gprintb dayname$(wd%),30
  197.         gmove 30,0 :gprintb num$(da%,2),16,1
  198.         gmove 20,0 :gprintb month$(mo%),30
  199.         if exists%
  200.             gmove 35,0 :gprintb Time$:(cur&,0,0),40,1
  201.             gmove 40,0 :gprintb "-",10
  202.             if a.leave&
  203.                 gmove  5,0 :gprintb Time$:(a.leave&,0,0),40,1
  204.                 gmove 50,0 :gprintb Time$:(a.leave&-cur&-a.normal&,1,0),45,1
  205.                 gmove 50,0 :gprintb Time$:(a.total&,1,0),55,1
  206.                 gmove 70,0
  207.             else
  208.                 gmove 175,0
  209.             endif
  210.             gprintb a.comment$,99
  211.         endif
  212.         MovRel:(1,0)
  213.         y% = y%+h% :lin%=lin%-1
  214.     endwh
  215.     ggrey 1 :gat 1,y%+4 :glineby 300,0 :ggrey 0
  216.     position oldpos% :cur&=oldcur& :exists%=oldex%
  217. ENDP
  218.  
  219.  
  220. PROC Time$:(t&,sign%,secs%)
  221.     local res$(30),yr%,mo%,da%,ho%,mi%,se%,yrd%
  222.     secstodate abs(t&),yr%,mo%,da%,ho%,mi%,se%,yrd%
  223.     if yr%=1970  :ho%=ho%+(da%-1)*24 :endif
  224.     if ho%<10    :res$=res$+" " :endif
  225.     if t&<0      :res$=res$+"-"
  226.     elseif sign% :res$=res$+"+"
  227.     endif
  228.     res$=res$+num$(ho%,3)+":"
  229.     if mi%<10 :res$=res$+"0" :endif
  230.     res$=res$+num$(mi%,2)
  231.     if secs%
  232.         res$=res$+":"
  233.         if se%<10 :res$=res$+"0" :endif
  234.         res$=res$+num$(se%,2)
  235.     endif
  236.     return res$
  237. ENDP
  238.  
  239. PROC RecED:
  240.     local m&,l&,n&,c$(20),morn&,even&
  241.     local yr%,mo%,dy%,hr%,mn%,sc%,yd%,wd%
  242.     local ret%,new$(13)
  243.     morn& = Early&:(cur&)
  244.     secstodate cur&,yr%,mo%,dy%,hr%,mn%,sc%,yd%
  245.     wd%=dow(dy%,mo%,yr%)
  246.     Rem See if an entry already exists
  247.     if exists%
  248.         m&=cur&-morn&
  249.         l&=a.leave&
  250.         if l& :l&=l&-morn& :endif
  251.         n&=a.normal&
  252.         c$=a.comment$
  253.         new$=""
  254.     else
  255.         Rem Fill in Defaults
  256.         m&=8*60*60
  257.         n&=setup&(wd%)
  258.         l&=m&+n&
  259.         new$="  (new entry)"
  260.     endif
  261.     Rem   Display edit dialog
  262.     dinit dayname$(wd%)+" "+num$(dy%,2)+" "+month$(mo%)+" "+num$(yr%,4)+new$
  263.     dtime m&,"Meet",1,0,maxday&
  264.     dtime l&,"Leave",1,0,maxday&
  265.     dtext "Worktime",Time$:(l&-m&,0,1),0
  266.     dtime n&,"Normal time",0,0,maxday&
  267.     dtext "Todays diff",Time$:(l&-m&-n&,1,1),0
  268.     dtext "Total diff",Time$:(a.total&,1,1),0
  269.     dedit c$,"Comment",20
  270.     lock on :ret% = dialog :lock off
  271.     if ret%
  272.         a.meet&=m&+morn&
  273.         if l& :l&=l&+morn& :if m&>l& :l&=l&+sad& :endif :endif
  274.         a.leave&=l&
  275.         a.normal&=n&
  276.         a.comment$=c$
  277.         if exists% :update :else :append :endif
  278.         Reorder:
  279.         PaintCur:
  280.     endif
  281. ENDP
  282.  
  283. PROC TextED:
  284.     local c$(20), ret%
  285.     if exists%
  286.         c$=a.comment$+chr$(a%(1))
  287.     else
  288.         a.meet&=cur&+28800  Rem current day at 08:00 => cur& + 8*60*60
  289.         a.normal&=0
  290.         a.leave&=0
  291.         c$=chr$(a%(1))
  292.     endif
  293.     dinit "Comment"
  294.     dedit c$,"",20
  295.     REM - So how do I position the cursor
  296.     REM to the end of the 'dedit' string ?
  297.     REM If you have an idea please tell me...
  298.     lock on :ret% = dialog :lock off
  299.     if ret%
  300.         a.comment$=c$
  301.         if exists% :update :else :append :endif
  302.         Reorder:
  303.         PaintCur:
  304.     endif
  305. ENDP
  306.  
  307. PROC SaveFile:
  308.     trap close
  309.     if err<>0 and err<>-102
  310.         ShowErr:("Error closing file")
  311.     endif
  312. ENDP
  313.  
  314. PROC PaintCur:
  315.     Cursor:
  316.     paint:(cur&,1)
  317.     Cursor:
  318. ENDP
  319.  
  320. Rem current entry is always the one
  321. Rem just less than or eual to cur&
  322. Rem exists% tells if tec really exists
  323.  
  324. PROC MovCurs:(d%)
  325.     local rd%
  326.     if abs(d%)>lines%
  327.         if d%>0
  328.             off&=Offset&:(cur&,1-lines%) :gcy%=gcmax%
  329.         else
  330.             off&=cur& :gcy%=0
  331.         endif
  332.         Repaint:
  333.         return
  334.     endif
  335.     Cursor:
  336.     gcy%=gcy%+d%*h%
  337.     if gcy%<0  rem Move UP (scrolls down)
  338.         rd% = gcy%/h%
  339.         off&=cur&
  340.         ggrey 2 :gscroll 0,-rd%*h%,1,4,410,gcmax% :ggrey 0
  341.         paint:(off&,-rd%)
  342.         gcy% = 0
  343.     elseif gcy%>gcmax%  rem Move DOWN (scrolls up)
  344.         rd% = (gcy%-gcmax%)/h%
  345.         off& = Offset&:(off&,rd%)
  346.         ggrey 2 :gscroll 0,-rd%*h%,1,4+h%,410,gcmax% :ggrey 0
  347.         paint:(Offset&:(off&,lines%-rd%),rd%)
  348.         gcy%=gcmax%
  349.     endif
  350.     Cursor:
  351. ENDP
  352.  
  353. Rem Move to Entry specified as time&
  354. Rem cur& will point to
  355. Rem 1) Entry, if exists
  356. Rem 2) Prev entry same day, if any
  357. Rem 3) Following entry same day, if any
  358. Rem 4) Start of day (exists%=0)
  359.  
  360. Proc MovTo:(time&,show%)
  361.     local day&,lin%,d&
  362.     d&=int(time&/sad&)-int(cur&/sad&)
  363.     if abs(d&)<50 and show%
  364.         lin%=d&
  365.         while a.meet&<time& and not eof
  366.             next
  367.             if int(a.meet&/sad&)=int(cur&/sad&) :lin%=lin%+1 :endif
  368.             cur&=a.meet&
  369.         endwh
  370.         if eof :back :endif
  371.         while a.meet&>time& and not eof
  372.             back
  373.             if int(a.meet&/sad&)=int(cur&/sad&) :lin%=lin%-1 :endif
  374.             cur&=a.meet&
  375.         endwh
  376.     else
  377.         REM - Fast seek
  378.         if time&>cur& :lin%=50 :else :lin%=-50 :endif
  379.         while a.meet&<time& and not eof :next :endwh
  380.         if eof :back :endif
  381.         while a.meet&>time& and not eof :back :endwh
  382.     endif
  383.     day&=Early&:(time&)
  384.     exists%=1 Rem Greatest probability
  385.     if a.meet&=time&
  386.         cur&=time&
  387.     elseif a.meet&>=day& and a.meet&<day&+sad&
  388.         cur&=a.meet&
  389.     else
  390.         next
  391.         if not eof and a.meet&>=day& and a.meet&<day&+sad&
  392.             cur&=a.meet&
  393.         else
  394.             back :cur&=day& :exists%=0
  395.         endif
  396.     endif
  397.     if show% :MovCurs:(lin%) :endif
  398. ENDP
  399.  
  400. PROC MovRel:(lin%,show%)
  401.     local l%,day&
  402.     l%=lin%
  403.     while l%<0 Rem go back
  404.         if exists% :back :endif
  405.         day&=Early&:(cur&)-sad& Rem Yesterday
  406.         if a.meet&<day&
  407.             cur&=day& :exists%=0
  408.         else
  409.             cur&=a.meet& :exists%=1
  410.         endif
  411.         l%=l%+1
  412.     endwh
  413.     while l%>0
  414.         next
  415.         day&=Early&:(cur&)+sad& Rem Tomorrow
  416.         if eof
  417.             back
  418.             cur&=day& :exists%=0
  419.         elseif a.meet&>=day&+sad& Rem after the morning of the day after tomorrow
  420.             back
  421.             cur&=day& :exists%=0
  422.         else
  423.             cur&=a.meet& :exists%=1
  424.         endif
  425.         l%=l%-1
  426.     endwh
  427.     if show% :MovCurs:(lin%) :endif
  428. ENDP
  429.  
  430. Proc MovCnt%:(time&,show%)
  431.     local lin%
  432.     while cur&<time& :MovRel:( 1,show%) :lin%=lin%+1 :endwh
  433.     while cur&>time& :MovRel:(-1,show%) :lin%=lin%-1 :endwh
  434.     if show% :MovCurs:(lin%) :endif
  435.     return lin%
  436. ENDP
  437.  
  438. PROC Reorder:
  439.     local p%,meet&,total&,cnt%
  440.     rem We know that only last rec
  441.     rem can be out of order
  442.     busy "Sorting"
  443.     last :meet&=a.meet&
  444.     if meet&
  445.         back
  446.         while meet&<a.meet& :cnt%=cnt%+1 :back :endwh
  447.         total&=a.total& :next :p%=pos
  448.         last
  449.         if a.leave& :total&=total&+a.leave&-a.meet&-a.normal& :endif
  450.         a.total&=total&
  451.         update Rem stll remains at end
  452.     else
  453.         Rem Little shortcut for rewriting
  454.         Rem setup record (meet&=0)
  455.         total&=a.total& :p%=1 :cnt%=pos-1
  456.     endif
  457.     while cnt%
  458.         position p%
  459.         if a.leave& :total&=total&+a.leave&-a.meet&-a.normal& :endif
  460.         a.total&=total&
  461.         update  Rem and move to end
  462.         cnt%=cnt%-1
  463.     endwh
  464.     onerr off
  465.     busy off
  466.     MovTo:(cur&,0)
  467. ENDP
  468.  
  469. PROC Offset&:(from&,lin%)
  470.     local oldcur&,oldpos%,oldex%,oldcurd&
  471.     local offs&
  472.     oldpos%=pos :oldcur&=cur& :oldex%=exists%
  473.     MovTo:(from&,0)
  474.     MovRel:(lin%,0)
  475.     offs&=cur&
  476.     position oldpos% :cur&=oldcur& :exists%=oldex%
  477.     return offs&
  478. ENDP
  479.  
  480. PROC Now&:
  481.     return datetosecs(year,month,day,hour,minute,second)
  482. ENDP
  483.  
  484. PROC Early&:(tim&)
  485.     return int(tim&/sad&)*sad&
  486. ENDP
  487.  
  488. PROC Mark:
  489.     local wd%,tim&,today&
  490.     tim&=Now&:
  491.     MovTo:(tim&,1)
  492.     today&=Early&:(tim&)
  493.     if a.meet&>=today& and a.meet&<today&+sad& and a.leave&=0
  494.         a.leave&=Now&:+setup&(9)
  495.         update :Reorder: :Repaint:
  496.     else
  497.         if cur&>tim& :MovCurs:(1) :endif
  498.         a.meet&=tim&-setup&(8)
  499.         a.leave&=0
  500.         wd%=dow(day,month,year)
  501.         a.normal&=setup&(wd%)
  502.         a.comment$=""
  503.         append
  504.         Reorder:
  505.         Repaint:
  506.         MovTo:(tim&,1)
  507.     endif
  508. ENDP
  509.  
  510. PROC x8: rem Delete
  511.     DelCur:
  512. ENDP
  513.  
  514. PROC x7f: rem shift-delete (backspace)
  515.     DelRang:
  516. ENDP
  517.  
  518. PROC DelCur:
  519.     local stat%,oldcur&
  520.     if exists%
  521.         oldcur&=cur&
  522.         dinit
  523.         dtext "","Remove"
  524.         dbuttons "Yes",%y,"No",%n
  525.         lock on : stat%=dialog :lock off
  526.         if stat%=%y
  527.             CopyBuf:
  528.             ERASE
  529.             cur&=0 :first :MovTo:(oldcur&,1)
  530.             giprint "Removed"
  531.         endif
  532.     else
  533.         giprint "Nothing to remove"
  534.     endif
  535. ENDP
  536.  
  537. PROC DelRang:
  538.     local stat%,from&,to&,cnt%,oldcur&
  539.     oldcur&=cur&
  540.     from&=cur&/sad&+d1970&
  541.     to&=cur&/sad&+1+d1970&
  542.     dinit
  543.     dtext "","Remove"
  544.     ddate from&,"from",d1970&,d2038&
  545.     ddate to&,"to (excl.)",d1970&,d2038&
  546.     dbuttons "Yes",%y,"No",%n
  547.     lock on : stat%=dialog :lock off
  548.     if stat%=%y
  549.         busy "Removing"
  550.         from&=(from&-d1970&)*sad&
  551.         to&=(to&-d1970&)*sad&
  552.         first
  553.         while a.meet&<from& :next :endwh
  554.         while a.meet&<to& and not eof
  555.             cnt%=cnt%+1
  556.             REM This is silly, when removing a range
  557.             REM only last entry is remembered
  558.             REM But to remember all takes up way too much memory (does it, really ?)
  559.             CopyBuf:
  560.             ERASE
  561.         endwh
  562.         onerr off
  563.         if cnt%
  564.             cur&=0 :first :MovTo:(oldcur&,1)
  565.             giprint num$(cnt%,5)+" entries removed"
  566.         else
  567.             giprint "No entries removed"
  568.         endif
  569.         busy off
  570.     endif
  571. ENDP
  572.  
  573. PROC CopyBuf:
  574.     onerr Problem::
  575.     rem Copy to paste buffer
  576.     bmeet&=a.meet&
  577.     bleave&=a.leave&
  578.     bnormal&=a.normal&
  579.     bcomnt$=a.comment$
  580. Problem::
  581. ENDP
  582.  
  583. PROC x9: rem TAB
  584.     JumpDate:
  585. ENDP
  586.  
  587. PROC xd: rem ENTER
  588.     RecED:
  589. ENDP
  590.  
  591. PROC x1b: rem ESC
  592.     call($198d,100,0)  Rem background
  593. ENDP
  594.  
  595. PROC x20: rem Space
  596.     Mark:
  597. ENDP
  598.  
  599. PROC x100: rem up
  600.     if a%(2) and 2  rem Shift
  601.         MovRel:(-3,1)
  602.     elseif a%(2) and 4  rem Control
  603.         MovTo:(cur&-30*sad&,1)
  604.     else
  605.         MovRel:(-1,1)
  606.     endif
  607. ENDP
  608.  
  609. PROC x101: rem down
  610.     if a%(2) and 2  rem Shift
  611.         MovRel:(3,1)
  612.     elseif a%(2) and 4  rem Control
  613.         MovTo:(cur&+30*sad&,1)
  614.         rem MovRel:(30,1)
  615.     else
  616.         MovRel:(1,1)
  617.     endif
  618. ENDP
  619.  
  620. rem PROC x102: rem right
  621. rem ENDP
  622. rem PROC x103: rem left
  623. rem ENDP
  624.  
  625. PROC x104: rem Page up
  626.     MovRel:(-10,1)
  627. ENDP
  628.  
  629. PROC x105: rem Page down
  630.     MovRel:(10,1)
  631. ENDP
  632.  
  633. rem PROC x106: rem Page right
  634. rem ENDP
  635. rem PROC x107: rem Page left
  636. rem ENDP
  637.  
  638. PROC x122: rem Menu
  639.     local menu%
  640.     minit
  641.     mcard "File","Open file",%o,"Make new file",%m,"Print",%p,"Who did this?",%w,"Exit",%x
  642.     mcard "Edit","Insert",%i,"Copy",%c,"Delete",%D,"Delete range",%R,"Edit",%e
  643.     mcard "Screen","Repaint",%r,"Sort/Recalc",%s,"Jump to date",%j,"Font type",%f,"Zoom in",%z,"Zoom out",%Z
  644.     mcard "Project","Begin",%b,"Project Usage",%u,"Delete project",%d
  645.     mcard "Settings","Normal worktime",%n,"Slack",%l
  646.     lock on :menu% = MENU :lock off
  647.     if menu%
  648.         onerr Error::
  649.         @("x"+hex$(menu%+$200)):
  650.     endif
  651.     return
  652. Error::
  653.     ShowErr:(hex$(menu%+$200))
  654. ENDP
  655.  
  656. PROC x123: rem Help
  657.     local file$(20)
  658.     file$="\opo\Workhelp.opo"
  659.     trap loadm file$
  660.     if err
  661.         ShowErr:("'"+file$+"' - Help not installed")
  662.     else
  663.         WorkHelp:
  664.         unloadm file$
  665.     endif
  666. ENDP
  667.  
  668. PROC x124: rem Star
  669.     WhoInfo:
  670. ENDP
  671.  
  672. PROC WhoInfo:
  673.     dinit "Worktime"
  674.     dtext "","Version 2.06",2
  675.     dtext "","Created January 1995",2
  676.     dtext "","by",2
  677.     dtext "","Erik Johansen",$102
  678.     dtext "","ej@id.dtu.dk",$102
  679.     dtext "","(icon by ja@id.dtu.dk)",2
  680.     dialog
  681. ENDP
  682.  
  683. PROC x244:
  684.     DelCur:
  685. ENDP
  686.  
  687. PROC x252:
  688.     DelRang:
  689. ENDP
  690.  
  691. PROC x262: rem psion-b = Begin project
  692.     local proj$(255),stat%,pronum%,newpro$(20)
  693.     if prolist$<>""
  694.         pronum%=1
  695.         dinit "Begin project"
  696.         dchoice pronum%,"Project:","<New project>,"+prolist$
  697.         lock on :stat%=dialog :lock off
  698.     else
  699.         Rem No projects defined
  700.         Rem Simulate selection of <NEW>
  701.         pronum%=1 :stat%=1
  702.     endif
  703.     if stat%
  704.         if pronum%=1
  705.             dinit "Begin new project"
  706.             dedit newpro$,"Project name:",20
  707.             lock on :stat%=dialog :lock off
  708.             if stat% and newpro$<>""
  709.                 proj$=newpro$
  710.                 if len(proj$)+len(prolist$)>254
  711.                     giprint "Project list too long; Cannot add"
  712.                 else
  713.                     if prolist$<>"" :prolist$=prolist$+"," :endif
  714.                     prolist$=prolist$+proj$
  715.                     SaveSet:  Rem update change to project list
  716.                 endif
  717.             else
  718.                 proj$=""
  719.             endif
  720.         else
  721.             proj$=prolist$
  722.             while pronum%>2 and loc(proj$,",")
  723.                 proj$=right$(proj$,len(proj$)-loc(proj$,","))
  724.                 pronum%=pronum%-1
  725.             endwh
  726.             if loc(proj$,",") :proj$=left$(proj$,loc(proj$,",")-1) :endif
  727.         endif
  728.         ProStart:(proj$)
  729.     endif
  730. ENDP
  731.  
  732. PROC ProStart:(proj$) rem Start project
  733.     local wd%,tim&,today&
  734.     tim&=Now&:
  735.     MovTo:(tim&,1)
  736.     today&=Early&:(tim&)
  737.     if a.leave&=0 and a.meet&>today& and a.meet&<today&+sad&
  738. rem    if exists% and a.leave&=0
  739.         if a.normal& :a.leave&=Now&:+setup&(9) :else a.leave&=Now&: :endif
  740.         update
  741.         Reorder:
  742.         MovTo:(tim&,1)
  743.     endif
  744.     if proj$<>""
  745.         if cur&>tim& :MovCurs:(1) :endif
  746.         a.meet&=tim&
  747.         a.leave&=0
  748.         a.normal&=0  Rem Projects won't use this
  749.         a.comment$=proj$
  750.         append
  751.         Reorder:
  752.         Repaint:
  753.         MovTo:(tim&,1)
  754.     endif
  755. ENDP
  756.  
  757. PROC x263: rem psion-c = Copy
  758.     if exists%
  759.         CopyBuf:
  760.         giprint "Copied"
  761.     else
  762.         giprint "Nothing to Copy"
  763.     endif
  764. ENDP
  765.  
  766. PROC x264: rem psion-d = Delete Project/Entry
  767.     local pronum%,stat%,proj$(255),delproj$(20)
  768.     if a%(2) and 2  rem Shift
  769.         DelCur:
  770.     elseif prolist$=""
  771.         giprint "No projects to delete"
  772.     else
  773.         dinit "Delete project"
  774.         dchoice pronum%,"Project:",prolist$
  775.         lock on :stat%=dialog :lock off
  776.         if stat%
  777.             proj$=""
  778.             while loc(prolist$,",")
  779.                 pronum%=pronum%-1
  780.                 if pronum% :proj$=proj$+left$(prolist$,loc(prolist$,",")) :else :delproj$=left$(prolist$,loc(prolist$,",")-1) :endif
  781.                 prolist$=right$(prolist$,len(prolist$)-loc(prolist$,","))
  782.             endwh
  783.             pronum%=pronum%-1
  784.             if pronum% :proj$=proj$+prolist$ :else :delproj$=prolist$ :if len(proj$) :proj$=left$(proj$,len(proj$)-1) :endif :endif
  785.             prolist$=proj$
  786.             giprint "Project '"+delproj$+"' deleted"
  787.         endif
  788.     endif
  789. ENDP
  790.  
  791. PROC x265: rem psion-e = Edit
  792.     RecED:
  793. ENDP
  794.  
  795. PROC x266: rem psion-f = Font type
  796.     local stat%,typ%
  797.     if fonttyp%=5 :typ%=1 :else :typ%=2 :endif
  798.     dinit "Font type"
  799.     dchoice typ%,"","Roman,Swiss"
  800.     lock on :stat%=dialog :lock off
  801.     if stat%
  802.         if typ%=1 :fonttyp%=5 :else fonttyp%=9 :endif
  803.         SetFont: :Repaint:
  804.         SaveSet:
  805.     endif
  806. ENDP
  807.  
  808. PROC x269: rem psion-i = Insert
  809.     if bmeet&
  810.         a.meet&=bmeet&-Early&:(bmeet&)+Early&:(cur&)
  811.         if bleave& :a.leave&=bleave&-Early&:(bleave&)+Early&:(cur&) :else :a.leave&=0 :endif
  812.         a.normal&=bnormal&
  813.         a.comment$=bcomnt$
  814.         append
  815.         Reorder:
  816.         Repaint:
  817.         MovTo:(cur&,1)
  818.     else
  819.         giprint "Nothing to insert"
  820.     endif
  821. ENDP
  822.  
  823. PROC x26a: rem psion-j = Jump to date
  824.     JumpDate:
  825. ENDP
  826.  
  827. PROC JumpDate:
  828.     local to&,ret%
  829.     to&=days(day,month,year)
  830.     dinit "Jump to date"
  831.     ddate to&,"",d1970&,d2038&
  832.     lock on :ret% = dialog :lock off
  833.     if ret%
  834.         Rem point to last entry of the day
  835.         MovTo:((to&-d1970&+1)*sad&-1,1)
  836.     endif
  837. ENDP
  838.  
  839. PROC x26c: rem psion-l = Slack
  840.     dinit "Slack setup"
  841.     dtime setup&(8),"Arrival",1,0,datetosecs(1970,1,1,0,59,59)
  842.     dtime setup&(9),"Leave",1,0,datetosecs(1970,1,1,0,59,59)
  843.     lock on :if dialog :SaveSet: :endif :lock off
  844. ENDP
  845.  
  846. PROC x26d: rem psion-m = Make new
  847.     local file$(128),ret%
  848.     dinit "Make new file"
  849.     dfile file$,"",$9
  850.     lock on :ret% = dialog :lock off
  851.     if ret%
  852.         SaveFile:
  853.         MkFile:(file$)
  854.     endif
  855. ENDP
  856.  
  857. PROC x26e: rem psion-n = Normal worktime
  858.     local n%
  859.     dinit "Normal worktime"
  860.     n%=1
  861.     while n%<=7
  862.         dtime setup&(n%),dayname$(n%),1,0,maxday&
  863.         n%=n%+1
  864.     endwh
  865.     lock on :if dialog :SaveSet: :endif :lock off
  866. ENDP
  867.  
  868. PROC SaveSet:
  869.     local n%,set$(255)
  870.     busy "Saving setup"
  871.     first :n%=1
  872.     while n%<=10
  873.         set$=set$+num$(setup&(n%),5)+chr$(13)
  874.         n%=n%+1
  875.     endwh
  876.     if len(set$)+len(prolist$)>254
  877.         set$=set$+left$(prolist$,254-len(set$))+chr$(13)
  878.         giprint "Long project list only saved partially"
  879.     else
  880.         set$=set$+prolist$+chr$(13)
  881.     endif
  882.     a.comment$=set$
  883.     update :Reorder:
  884.     busy off
  885.     giprint "Saved"
  886. ENDP
  887.  
  888. PROC x26f: rem psion-o = Open/Load
  889.     local file$(128),ret%
  890.     dinit "Open file"
  891.     dfile file$,"",$10
  892.     lock on
  893.     if dialog
  894.         SaveFile:
  895.         OpenFile:(file$)
  896.     endif
  897.     lock off
  898. ENDP
  899.  
  900. PROC x270: rem psion-p Print
  901.     local outfile$(128),stat%,from&,to&,showsec%,showpro%
  902.     local yr%,mo%,da%,ho%,m%,s%,yrd%,wd%
  903.     local p%,pcnt%,proj$(30,20),puse&(30)
  904.     local transf&,projlen%
  905.     local oldcur&,oldpos%,oldex%,oldcurd&
  906.  
  907.     outfile$="LOC::M:\Time.out"
  908.     showpro%=2
  909.     dinit "Print to file"
  910.     dfile outfile$,"File",1
  911.     from&=days(1,month,year)
  912.     if month<12 :to&=days(1,month+1,year) :else :to&=days(1,1,year+1) :endif
  913.     ddate from&,"from",d1970&,d2038&
  914.     ddate to&,"to (excl.)",d1970&,d2038&
  915.     dchoice showsec%,"Show secs","No,Yes"
  916.     dchoice showpro%,"Show Projects","No,Yes"
  917.     lock on :stat% = dialog :lock off
  918.     if stat%=0 :return :endif
  919.  
  920.     from&=(from&-d1970&)*sad&
  921.     to&=(to&-d1970&)*sad&
  922.     showsec%=showsec%-1
  923.     showpro%=showpro%-1
  924.  
  925.     oldpos%=pos :oldcur&=cur& :oldex%=exists%
  926.     lopen outfile$
  927.     busy "Printing"
  928.     MovTo:(from&,0)
  929.     if exists% :back :endif
  930.     transf&=a.total&
  931.     if exists% :next :endif
  932.     lprint "Transfer";rept$(" ",41+12*showsec%)+Time$:(transf&,1,showsec%)
  933.     while (cur& < to&)
  934.         secstodate cur&,yr%,mo%,da%,ho%,m%,s%,yrd%
  935.         wd% = dow(da%,mo%,yr%)
  936.         lprint dayname$(wd%);" ";num$(da%,-2);". ";month$(mo%);
  937.         if exists%
  938.             lprint "  ";Time$:(cur&,0,showsec%);" -";
  939.             if a.leave&
  940.                 lprint " ";Time$:(a.leave&,0,showsec%);"  ";Time$:(a.leave&-cur&,0,showsec%);" ";Time$:(a.normal&,0,0);"  ";Time$:(a.leave&-cur&-a.normal&,1,showsec%);"  ";Time$:(a.total&,1,showsec%);
  941.                 transf&=a.total&
  942.                 if a.comment$<>""
  943.                     lprint "   ";a.comment$;
  944.                     if showpro%
  945.                         p%=1 :while p%<=pcnt% and proj$(p%)<>a.comment$ :p%=p%+1 :endwh
  946.                         if proj$(p%)<>a.comment$ and pcnt%<30
  947.                             pcnt%=pcnt%+1
  948.                             proj$(pcnt%)=a.comment$ :p%=pcnt%
  949.                             projlen%=max(projlen%,len(a.comment$))
  950.                         endif
  951.                         puse&(p%)=puse&(p%)+a.leave&-cur&
  952.                     endif
  953.                 endif
  954.             elseif a.comment$<>""
  955.                 lprint rept$(" ",38+12*showsec%);a.comment$;
  956.             endif
  957.         endif
  958.         lprint
  959.         MovRel:(1,0)
  960.     endwh
  961.     lprint "Transfer";rept$(" ",41+12*showsec%)+Time$:(transf&,1,showsec%)
  962.     if pcnt%
  963.         lprint :lprint "Project totals:"
  964.         p%=1 :projlen%=projlen%+2
  965.         while p%<=pcnt%
  966.             lprint proj$(p%);rept$(" ",projlen%-len(proj$(p%)));Time$:(puse&(p%),0,showsec%)
  967.             p%=p%+1
  968.         endwh
  969.     endif
  970.     lclose
  971.     busy off
  972.     position oldpos% :cur&=oldcur& :exists%=oldex%
  973. ENDP
  974.  
  975. PROC x272:  rem psion-r - Repaint
  976.     if a%(2) and 2  rem Shift
  977.         DelRang:
  978.     else
  979.         Repaint:
  980.     endif
  981. ENDP
  982.  
  983. PROC x273: rem psion-s = Sort
  984.     local last%,e%,e&,lpos%,total&
  985.     busy "Sorting"
  986.     last :last%=pos
  987.     if count>0
  988.         while last%<>0
  989.             position last% :e%=pos
  990.             e&=a.meet&
  991.             do
  992.                 if a.meet&<e& :e&=a.meet& :e%=pos :endif
  993.                 lpos%=pos :BACK
  994.             until POS=1 and lpos%=1
  995.             position e%
  996.             if a.leave& :total&=total&+a.leave&-a.meet&-a.normal& :endif
  997.             a.total&=total&
  998.             update :last%=last%-1
  999.         endwh
  1000.     endif
  1001.     busy off
  1002.     giprint num$(count-1,5)+" entries sorted"
  1003.     Repaint:
  1004. ENDP
  1005.  
  1006. PROC x275:  Rem Psion-U Project Usage
  1007.     local yr%,mo%,da%,ho%,m%,s%,yrd%,wd%
  1008.     local p%,po%,pcnt%,lin$(255),proj$(30,20),puse&(30)
  1009.     local oldcur&,oldpos%,oldex%,oldcurd&
  1010.     local stat%,from&,to&,showsec%
  1011.     showsec%=2
  1012.     dinit "Project Usage"
  1013.     from&=days(1,month,year)
  1014.     if month<12 :to&=days(1,month+1,year) :else :to&=days(1,1,year+1) :endif
  1015.     ddate from&,"from",d1970&,d2038&
  1016.     ddate to&,"to (excl.)",d1970&,d2038&
  1017.     dchoice showsec%,"Show secs","No,Yes"
  1018.     lock on :stat% = dialog :lock off
  1019.     if stat%=0 or from&>to& :return :endif
  1020.     from&=(from&-d1970&)*sad&
  1021.     to&=(to&-d1970&)*sad&
  1022.     showsec%=showsec%-1
  1023.     REM Calc
  1024.     oldpos%=pos :oldcur&=cur& :oldex%=exists%
  1025.     busy "Calculating"
  1026.     MovTo:(from&,0)
  1027.     if not exists% :next :endif
  1028.     while a.meet&<to& and not eof
  1029.         if a.leave& and a.comment$<>""
  1030.             p%=1 :while p%<=pcnt% and proj$(p%)<>a.comment$ :p%=p%+1 :endwh
  1031.             if proj$(p%)<>a.comment$ and pcnt%<30
  1032.                 pcnt%=pcnt%+1 :proj$(pcnt%)=a.comment$ :p%=pcnt%
  1033.             endif
  1034.             puse&(p%)=puse&(p%)+a.leave&-a.meet&
  1035.         endif
  1036.         next
  1037.     endwh
  1038.     busy off
  1039.     if pcnt%
  1040.         po%=1
  1041.         while 1
  1042.             dinit "Project totals"
  1043.             p%=po%
  1044.             while p%<po%+5 and p%<=pcnt%
  1045.                 dtext proj$(p%),Time$:(puse&(p%),0,showsec%),1
  1046.                 p%=p%+1
  1047.             endwh
  1048.             if pcnt%<8
  1049.             elseif po%<2       :dbuttons "Down",&101
  1050.             elseif po%>pcnt%-5 :dbuttons "Up",&100
  1051.             else               :dbuttons "Up",&100,"Down",&101
  1052.             endif
  1053.             lock on :stat% = dialog :lock off
  1054.             if         stat%=&100 :po%=po%-1
  1055.             elseif stat%=&101 :po%=po%+1
  1056.             else
  1057.                 break
  1058.             endif
  1059.         endwh
  1060.     else
  1061.         giprint "No projects found"
  1062.     endif
  1063.     position oldpos% :cur&=oldcur& :exists%=oldex%
  1064. ENDP
  1065.  
  1066. PROC x277: rem psion-w = Who created this ?
  1067.     WhoInfo:
  1068. ENDP
  1069.  
  1070. PROC x278: rem psion-x = Exit
  1071.     SaveFile: :stop
  1072. ENDP
  1073.  
  1074. PROC x27a: rem psion-z = Zoom
  1075.     if a%(2) and 2  rem Shift
  1076.         zoom%=zoom%-1 :if zoom%<0 :zoom%=3 :endif
  1077.     else
  1078.         zoom%=zoom%+1 :if zoom%>3 :zoom%=0 :endif
  1079.     endif
  1080.     SetFont: :Repaint: :SaveSet:
  1081. ENDP
  1082.  
  1083. PROC x401: rem Foreground
  1084. ENDP
  1085.  
  1086. PROC x402: rem Background
  1087. ENDP
  1088.  
  1089. Rem To enable wakeup (power on) signals
  1090. Rem add the following call at start of
  1091. Rem the program:
  1092. Rem
  1093. Rem    call($6c8d) rem want wakeup signal
  1094. Rem How come the signal comes in anyway ?
  1095. Rem
  1096. PROC x403: rem Powerup
  1097. ENDP
  1098.  
  1099. PROC x404: rem sys request
  1100.     local c$(129)
  1101.     c$ = getcmd$
  1102.     SysReq:(left$(c$,1),mid$(c$,2,128))
  1103. ENDP
  1104.  
  1105. PROC x405: rem Date change
  1106.     MovTo:(Now&:,1)
  1107. ENDP
  1108.  
  1109. PROC x2000: rem + contrast
  1110. ENDP
  1111.  
  1112. PROC x2001: rem - contrast
  1113. ENDP
  1114.  
  1115. REM ===== Project keys =====
  1116.  
  1117. PROC x6c: REM 'l'-key
  1118.     ProStart:("Lunch")
  1119. ENDP
  1120.  
  1121. PROC x6d: REM 'm'-key
  1122.     ProStart:("Meeting")
  1123. ENDP
  1124.  
  1125. PROC x74: REM 't'-key
  1126.     ProStart:("Transport")
  1127. ENDP
  1128.  
  1129.