home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / UTILITY / TIMER.M < prev    next >
Encoding:
Text File  |  1990-11-27  |  15.8 KB  |  385 lines
  1.  
  2.         (*  Timer -- Ein kleines Uhraccessory, das die Uhrzeit auf  *
  3.          *           Wunsch am rechten Rand einer jeden Menuleiste  *
  4.          *           anzeigt.                                       *
  5.          *                                                          *
  6.          *  Erstellt von Manuel Chakravarty          09.08.1987     *
  7.          *  Korrekturen Th. Tempelmann               27.11.1990     *
  8.          *                                                          *
  9.          *  Entwickelt mit dem Megamax Modula-2 Entwicklungspaket   *)
  10.  
  11.         (* Erzeugung des Accessory:                                 *
  12.          *                                                          *
  13.          *   Dieses Modul compilieren, dann in den Linker-Optionen  *
  14.          *   'GEMError' und 'GEMIO' abschalten (nur 'M2INIT' darf   *
  15.          *   noch aktiv sein). Programm linken (z.B. mit Ctrl-L)    *
  16.          *   und Datei auf das Wurzelverzeichnis Ihrer Boot-Disk    *
  17.          *   (C:\, wenn Harddisk vorhanden) kopieren.               *)
  18.  
  19.  
  20. MODULE Timer;
  21. (*$R-,S-     Keine Bereichs-, Überlauf- und Stackprüfung *)
  22. (*$E MAC     Endung für Linker: ACC erzeugen *)
  23.  
  24. FROM SYSTEM IMPORT WORD,
  25.                    ADR;
  26.  
  27. FROM Strings IMPORT String,
  28.                     Concat, Length, Split;
  29.  
  30. FROM TimeConvert IMPORT TextToDate, TextToTime, DateToText, TimeToText;
  31.  
  32. FROM Clock IMPORT Date, Time,
  33.                   CurrentDate, CurrentTime, SetDateAndTime, PackTime, PackDate;
  34.  
  35. FROM PrgCtrl IMPORT Accessory;
  36.  
  37. FROM GrafBase IMPORT Point, Rectangle, black, white,
  38.                      Pnt, Rect;
  39.  
  40. FROM GEMGlobals IMPORT NoObject, ObjType, ObjFlag, OFlagSet, ObjState,
  41.                        OStateSet, PtrObjTree, StandardFont, SmallFont,
  42.                        THorJust, MButtonSet, SpecialKeySet, GemChar;
  43.  
  44. FROM GEMEnv IMPORT RC, DeviceHandle,
  45.                    InitGem;
  46.  
  47. FROM AESForms IMPORT FormDialMode,
  48.                      FormDial, FormDo, FormAlert, FormCenter;
  49.  
  50. FROM VDIOutputs IMPORT GrafText;
  51.  
  52. FROM AESEvents IMPORT RectEnterMode, Event, EventSet, MessageBuffer, accOpen,
  53.                       MessageEvent, MultiEvent;
  54.  
  55. FROM VDIAttributes IMPORT SetTextColor;
  56.  
  57. FROM AESObjects IMPORT DrawObject, ChangeObjState;
  58.  
  59. FROM AESWindows IMPORT UpdateWindow;
  60.  
  61. FROM AESMenus IMPORT RegisterAcc;
  62.  
  63. FROM ObjHandler IMPORT SetPtrChoice,
  64.                        CreateObjTree, SetCurrObjTree,
  65.                        CurrObjTree, SetObjRelatives, SetObjType, SetObjFlags,
  66.                        SetObjState, SetObjSpace, CreateSpecification,
  67.                        LinkTextString, AssignTextStrings, SetTextForm,
  68.                        SetBorderThickness, SetComplexColor, ObjectState;
  69.  
  70.  
  71. CONST   RightBarX               =567;   (* Die Koordinaten an der die Uhrzeit *)
  72.         RightBarY               =15;    (* angezeigt werden soll(Monochrom)   *)
  73.         EraseString             ='        '; (* 8 Spaces zum Uhrzeit löschen *)
  74.  
  75. TYPE    CharSet                 =SET OF CHAR;
  76.  
  77. VAR     ShowTime                :BOOLEAN;       (* Zeit anzeigen? *)
  78.         MenuID                  :CARDINAL;      (* Unsere Accessory ID *)
  79.         dev                     :DeviceHandle;
  80.         ProgramName             :ARRAY[0..40] OF CHAR; (* String, der in der *
  81.                                                  * Menuleiste erscheinen soll*)
  82.         TimePrintSpot           :Point;
  83.                 (* Die beiden Strings sind Teile des TimeBox Objektbaumes *
  84.                  * sie enthalten die Zeit- bzw. die Datumsangabe der Box. *
  85.                  * 'readyBut' ist die Objektnummer des Ready-Knopfes und  *
  86.                  * 'showMark' die Nummer der 'ShowTime'-Box. 'start' ist  *
  87.                  * das Objekt bei dem mit dem edieren begonnen werden soll*
  88.                  * und 'root' ist ein Zeiger auf die Wurzel des Obj.baumes*
  89.                  * 'frame' enthält die Ausmaße der Box.                   *)
  90.         TimeBoxGlobals          :RECORD
  91.                                    root                 :PtrObjTree;
  92.                                    boxTime,boxDate      :String;
  93.                                    readyBut,showMark,
  94.                                    start                :CARDINAL;
  95.                                    frame                :Rectangle;
  96.                                  END;
  97.  
  98.         voidO                   : BOOLEAN;
  99.  
  100.  
  101. PROCEDURE BuildTimeBox(showTime:BOOLEAN);
  102.  
  103.   BEGIN
  104.     WITH TimeBoxGlobals DO
  105.       CreateObjTree(8, FALSE, voidO);     (* Baum mit 8 Elementen erzeugen *)
  106.       root:=CurrObjTree();                (* Und Wurzelzeiger merken *)
  107.           (* #0 *)
  108.       SetObjRelatives(0, NoObject,1,7);
  109.       SetObjType(0, boxObj);SetObjState(0, OStateSet{outlineObj});
  110.       SetObjFlags(0, OFlagSet{});
  111.       SetComplexColor(0, black,black,white,7,FALSE);
  112.       SetBorderThickness(0, 2);
  113.       SetObjSpace(0, Rect(0,0,26*8,10*16));
  114.           (* #1 *)
  115.       SetObjRelatives(1, 2,NoObject,NoObject);
  116.       SetObjType(1, stringObj);SetObjState(1, OStateSet{});
  117.       SetObjFlags(1, OFlagSet{});
  118.       AssignTextStrings(1, create,'Uhr-Parameter',noChange,'',noChange,'');
  119.       SetTextForm(1, StandardFont,centerJust);
  120.       SetObjSpace(1, Rect(6*8,16,13*8,16));
  121.           (* #2 *)
  122.       SetObjRelatives(2, 3,NoObject,NoObject);
  123.       SetObjType(2, textObj);SetObjState(2, OStateSet{});
  124.       SetObjFlags(2, OFlagSet{});
  125.       CreateSpecification(2, NIL);
  126.       AssignTextStrings(2, create,'MCH',noChange,'',noChange,'');
  127.       SetTextForm(2, SmallFont,centerJust);
  128.       SetComplexColor(2, black,black,black,0,FALSE);
  129.       SetObjSpace(2, Rect(22*8,6,3*8,8));
  130.           (* #3 *)
  131.       SetObjRelatives(3, 4,NoObject,NoObject);
  132.       SetObjType(3, fBoxTextObj);SetObjState(3, OStateSet{});
  133.       SetObjFlags(3, OFlagSet{editFlg});
  134.       CreateSpecification(3, NIL);
  135.       LinkTextString(3, ADR(boxTime));
  136.       AssignTextStrings(3, setOnly,'',create,'Uhrzeit - __:__:__',create,'999999');
  137.       SetTextForm(3, StandardFont,centerJust);
  138.       SetBorderThickness(3, 0);
  139.       SetComplexColor(3, black,black,black,0,TRUE);
  140.       SetObjSpace(3, Rect(3*8,3*16,18*8,16));
  141.       start:=3;                  (* Edieren soll bei diesem Object beginnen *)
  142.           (* #4 *)
  143.       SetObjRelatives(4, 5,NoObject,NoObject);
  144.       SetObjType(4, fBoxTextObj);SetObjState(4, OStateSet{});
  145.       SetObjFlags(4, OFlagSet{editFlg});
  146.       CreateSpecification(4, NIL);
  147.       LinkTextString(4, ADR(boxDate));
  148.       AssignTextStrings(4, setOnly,'',create,'Datum   - __.__.____',
  149.                         create,'99999999');
  150.       SetTextForm(4, StandardFont,centerJust);
  151.       SetBorderThickness(4, 0);
  152.       SetComplexColor(4, black,black,black,0,TRUE);
  153.       SetObjSpace(4, Rect(3*8,4*16,20*8,16));
  154.           (* #5 *)
  155.       SetObjRelatives(5, 6,NoObject,NoObject);
  156.       SetObjType(5, boxObj);SetObjState(5, OStateSet{});
  157.       IF showTime THEN SetObjState(5, OStateSet{checkObj}) END;
  158.       SetObjFlags(5, OFlagSet{selectFlg,selectExitFlg});
  159.       SetComplexColor(5, black,black,white,7,FALSE);
  160.       SetBorderThickness(5, -1);
  161.       SetObjSpace(5, Rect(5*8,6*16,2*8,16));
  162.       showMark:=5;
  163.           (* #6 *)
  164.       SetObjRelatives(6, 7,NoObject,NoObject);
  165.       SetObjType(6, stringObj);SetObjState(6, OStateSet{});
  166.       SetObjFlags(6, OFlagSet{});
  167.       AssignTextStrings(6, create,'Uhr anzeigen',noChange,'',noChange,'');
  168.       SetTextForm(6, StandardFont,centerJust);
  169.       SetObjSpace(6, Rect(8*8,6*16,12*8,16));
  170.           (* #7 *)
  171.       SetObjRelatives(7, 0,NoObject,NoObject);
  172.       SetObjType(7, buttonObj);SetObjState(7, OStateSet{});
  173.       SetObjFlags(7, OFlagSet{lastObjFlg,defaultFlg,selectFlg,
  174.                               selectExitFlg});
  175.       AssignTextStrings(7, create,'Alles klar!',noChange,'',noChange,'');
  176.       SetTextForm(7, StandardFont,centerJust);
  177.       SetObjSpace(7, Rect(6*8,8*16,13*8,16));
  178.       readyBut:=7;
  179.       frame:=FormCenter(root);
  180.     END;
  181.   END BuildTimeBox;
  182.  
  183. (*  DoTimeDialog -- geg.: aktuelle Zeit 'time', aktuelles Datum 'date' und *
  184.  *                        Flag, das angibt, ob die Uhrzeit angezeigt wird  *
  185.  *                        'showTime'.                                      *
  186.  *                  ges.: Die Zeit, das Datum und das Flag vom User ediert *)
  187.  
  188. PROCEDURE DoTimeDialog(VAR time:Time; VAR date:Date; VAR showTime:BOOLEAN);
  189.  
  190.   VAR   exitObj                 : CARDINAL; (* Zuletzt angesprochenes Objekt *)
  191.         term,success            : BOOLEAN;  (* Schleifenterminierungsflag *)
  192.         str                     : String;
  193.         smallFrame              : Rectangle;
  194.  
  195.   PROCEDURE strToTime(REF timeStr:ARRAY OF CHAR;VAR time:Time):BOOLEAN;
  196.     VAR valid: BOOLEAN;
  197.     BEGIN
  198.       TextToTime (timeStr, time, valid);
  199.       RETURN valid
  200.     END strToTime;
  201.  
  202.   PROCEDURE strToDate(REF dateStr:ARRAY OF CHAR;VAR date:Date):BOOLEAN;
  203.     VAR valid: BOOLEAN;
  204.     BEGIN
  205.       TextToDate (dateStr, 0, date, valid);
  206.       RETURN valid
  207.     END strToDate;
  208.  
  209.   BEGIN
  210.     WITH TimeBoxGlobals DO
  211.       SetCurrObjTree(root, FALSE);      (* TimeBox beim 'ObjHandler' anmelden *)
  212.       TimeToText (time, "HHMMSS", boxTime);    (* Zeit für die Box setzen *)
  213.       DateToText (date, "DDMMYYYY", boxDate);  (* Datum für die Box setzen *)
  214.  
  215.       smallFrame:=Rect(40,40,40,40);
  216.       FormDial(reserveForm,smallFrame,frame); (* Bringe Box auf den Schirm *)
  217.       FormDial(growForm,smallFrame,frame);
  218.       DrawObject(root,0,3,frame);
  219.  
  220.       FormDo(root,start, exitObj);        (* Erste Dialogsitzung *)
  221.       term:=FALSE;                        (* Initialisierung von 'term' *)
  222.       REPEAT
  223.                (* Stelle den alten Object.State des 'exitObj' wieder her *)
  224.         ChangeObjState (root,exitObj,frame,
  225.                         ObjectState (exitObj) - OStateSet{selectObj},TRUE);
  226.  
  227.         IF exitObj = showMark THEN
  228.           showTime:=NOT showTime;  (* toggle mark *)
  229.           IF showTime THEN
  230.             ChangeObjState (root,exitObj,frame,
  231.                             ObjectState (exitObj) + OStateSet{checkObj}, TRUE)
  232.           ELSE
  233.             ChangeObjState (root,exitObj,frame,
  234.                             ObjectState (exitObj) - OStateSet{checkObj}, TRUE)
  235.           END;
  236.         ELSIF exitObj = readyBut THEN         (* Der Anwender ist fertig *)
  237.           IF strToTime(boxTime,time) AND strToDate(boxDate,date) THEN
  238.             term:=TRUE;    (* Ende des Dialogs, falls die Werte erlaubt sind *)
  239.           END;
  240.         END;
  241.  
  242.         IF NOT term THEN FormDo(root,start, exitObj) END; (* Weiterer Dialog *)
  243.       UNTIL term;
  244.  
  245.       FormDial (shrinkForm,smallFrame,frame);  (* Entfernt Box vom Schirm *)
  246.       FormDial (freeForm,smallFrame,frame);
  247.     END; (* WITH *)
  248.   END DoTimeDialog;
  249.  
  250. (*  SetClock -- Stellt die Uhr mit Hilfe einer Dialogbox. 'showTime' *
  251.  *              gibt an, ob die Uhrzeit in der Menuleiste angezeigt  *
  252.  *              werden soll.                                         *)
  253.  
  254. PROCEDURE SetClock(VAR showTime:BOOLEAN);
  255.  
  256.   VAR     time1, time2            : Time;
  257.           date1, date2            : Date;
  258.           showTimeOld             : BOOLEAN;
  259.         
  260.   BEGIN
  261.     time1:=CurrentTime();date1:=CurrentDate();  (* Erfrage Datum und Uhrzeit *)
  262.     time2:=time1;date2:=date1;  (* Merke dir die Zeit für späteren Vergleich *)
  263.     showTimeOld:=showTime;        (* Merke dir ob die Uhrzeit angezeigt wird *)
  264.     DoTimeDialog(time2,date2,showTime);           (* Sprich mit dem Benutzer *)
  265.  
  266.       (* Falls die Uhrzeit nicht mehr angezeigt werden soll, so lösche sie *)
  267.  
  268.     IF showTimeOld AND NOT showTime THEN
  269.       SetTextColor(dev,black);
  270.       GrafText(dev,TimePrintSpot,EraseString);
  271.     END;
  272.  
  273.       (* Eventuell neue Datums- und Uhrzeitwerte setzen *)
  274.  
  275.     IF PackDate(date1)#PackDate(date2) THEN
  276.       SetDateAndTime(date2,CurrentTime())
  277.     END;
  278.     IF PackTime(time1)#PackTime(time2) THEN
  279.       SetDateAndTime(CurrentDate(),time2)
  280.     END;
  281.   END SetClock;
  282.  
  283. (*  PrintTime -- Zeige Uhrzeit in rechter Ecke der Menuleiste in *
  284.  *               'Digitalzahlen' an.                             *)
  285.  
  286. PROCEDURE PrintTime;
  287.  
  288.   CONST   digital0        =20C;
  289.  
  290.   VAR     time            :Time;
  291.           timeStr         :String;
  292.           success         :BOOLEAN;
  293.           i               :CARDINAL;
  294.  
  295.   BEGIN
  296.     time:=CurrentTime();                    (* Ermittle die aktuelle Zeit *)
  297.     TimeToText (time, "HH:MM:SS", timeStr); (* und mache eine String daraus *)
  298.  
  299.     FOR i:=0 TO Length(timeStr)-1 DO    (* Wandle die Ziffern in 'Digitalzif' *)
  300.       IF timeStr[i] IN CharSet{'0'..'9'} THEN
  301.         timeStr[i]:=CHR( ORD(timeStr[i]) -ORD('0')+ORD(digital0));
  302.       END;
  303.     END;
  304.  
  305.     SetTextColor(dev,black);
  306.     GrafText(dev,TimePrintSpot,timeStr);
  307.   END PrintTime;
  308.  
  309.  
  310. (*  EventLoop -- Die Hauptschleife des Programmes, die darauf wartet das *
  311.  *               ein Ereignis auftritt, welches das Accessory aktiviert. *)
  312.  
  313. PROCEDURE EventLoop;
  314.  
  315.   CONST   repTime = 2000L; (* Die Aussgabe der Uhrzeit erfolgt alle    *
  316.                             * 2000ms, kleinste Einheit der GEMDOS-Zeit *)
  317.  
  318.   VAR     events          : EventSet;      (* Die aufgetrettenen Ereignisse *)
  319.           msg             : MessageBuffer;
  320.  
  321.                   (* Variablen für VAR-Parameter, die nicht benutzt werden. *)
  322.           loc             : Point;
  323.           buts            : MButtonSet;
  324.           specials        : SpecialKeySet;
  325.           key             : GemChar;
  326.           clicks          : CARDINAL;
  327.  
  328.   BEGIN
  329.     REPEAT
  330.       MultiEvent (EventSet {message,timer},
  331.                   0, MButtonSet {}, MButtonSet {},
  332.                   lookForEntry, Rect (0,0,0,0), lookForEntry, Rect (0,0,0,0),
  333.                   msg, repTime,
  334.                   loc, buts, specials, key, clicks, events);
  335.       IF message IN events THEN
  336.         IF msg.msgType = accOpen THEN
  337.           SetClock (ShowTime);   (* Das Acc. wurde angeklickt => Uhr stellen *)
  338.         END;
  339.       END;
  340.       IF (timer IN events) AND ShowTime THEN
  341.         (* Falls 2s vergangen sind und Zeitanzeige gewünscht *)
  342.         (* ist, dann Zeit in der Menuleiste ausgeben.        *)
  343.         UpdateWindow (TRUE);  (* Absichern wg. GEMDOS-Aufrufen *)
  344.         PrintTime;
  345.         UpdateWindow (FALSE);
  346.       END;
  347.     UNTIL FALSE;        (* Endlosschleife! Ein Acc. terminiert nie. *)
  348.   END EventLoop;
  349.  
  350.  
  351. VAR     voidC           : CARDINAL;
  352.         ok              : BOOLEAN;
  353.         msg             : MessageBuffer;
  354.         
  355. BEGIN
  356.   ProgramName:="  Chaki's Clock ";      (* Der Name des Acc. *)
  357.   ShowTime:=TRUE;                       (* Voreinstellung: Zeit anzeigen! *)
  358.   TimePrintSpot:=Pnt(RightBarX,RightBarY);  (* Hier wird die Zeit hingedruckt *)
  359.   
  360.   InitGem (RC, dev, ok);
  361.   IF ok THEN                           (* Anmeldung der Application beim GEM *)
  362.     IF Accessory () THEN
  363.       RegisterAcc(ADR(ProgramName), MenuID, ok);   (* Acc. beim GEM anmelden *)
  364.       IF ok THEN
  365.         UpdateWindow (TRUE);        (* Vorerst absichern gegen Prozeßwechsel *)
  366.         (* zw. diesen UpdateWindow-Aufrufen dürfen nun die RSC-Datei geladen,*)
  367.         (* Speicher angefordert und weitere AES-Funktionen aufgerufen werden *)
  368.         BuildTimeBox(ShowTime);       (* Erstellt den Objektbaum der TimeBox *)
  369.         IF ShowTime THEN PrintTime END;     (* Zeit anzeigen, wenn gefordert *)
  370.         UpdateWindow (FALSE);
  371.         EventLoop;                              (* Aufruf der Endlosschleife *)
  372.       ELSE
  373.         FormAlert(1,'[3][Timer-Accessory kann |nicht angemeldet werden ][ OK ]',voidC);
  374.         (* leere Event-Schleife, weil ACCs nicht terminieren dürfen *)
  375.         LOOP MessageEvent (msg); END
  376.       END
  377.     ELSE
  378.       (* Wenn nicht als ACC gestartet, dann lassen wir nur Zeit/Datum
  379.        * eingeben und beenden das Prg dann wieder *)
  380.       BuildTimeBox(FALSE);            (* Erstellt den Objektbaum der TimeBox *)
  381.       SetClock (ShowTime);                                    (* Uhr stellen *)
  382.     END;
  383.   END;
  384. END Timer.
  385.