home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / pocketbk / utilsu / worktime20 / v2.06 / worktime.opl < prev    next >
Text File  |  1995-01-04  |  25KB  |  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&:(o