home *** CD-ROM | disk | FTP | other *** search
/ MacGames Sampler / PHT MacGames Bundle.iso / MacSource Folder / Samples from the CD / Pascal / Source□ / Talk Source / Talk ƒ / OOStatus.p < prev    next >
Encoding:
Text File  |  1992-04-20  |  13.6 KB  |  573 lines  |  [TEXT/PJMM]
  1. unit OOStatus;
  2.  
  3. { This program was written by Peter N Lewis, Mar 1992 in THINK Pascal 4.0.1 }
  4.  
  5. interface
  6.  
  7.     uses
  8.         OOMainLoop;
  9.  
  10.     type
  11.         requestDirection = (RD_incoming, RD_outgoing, RD_whatever);
  12.         requestState = (RS_request, RS_connecting, RS_connected, RS_disconnected, RS_failed, RS_whatever);
  13.         statusCommands = (SC_None, SC_Abort, SC_Connect, SC_BringToFront);
  14.  
  15.     procedure InitOOStatus (HandleStatusCommand: procPtr);
  16. { procedure HandleStatusCommand(data:longInt;sc:statusCommand;var s:string) }
  17.     procedure FinishOOStatus;
  18.     procedure SetEntry (data: univ longInt; rd: requestDirection; rs: requestState; title: str255);
  19.     procedure RemoveEntry (data: univ longInt);
  20.     procedure ShowStatus;
  21.  
  22. implementation
  23.  
  24.     uses
  25.         AppGlobals, MyTypes, MyUtils, MyFMenus, MyPreferences, PrefsGlobals, LDEFTypes, MyDialogs, TalkTos;
  26.  
  27.     type
  28.         StatusObject = object(DObject)
  29.                 procedure Create (id: integer);
  30.                 override;
  31.                 procedure Destroy;
  32.                 override;
  33.                 procedure DoClose;
  34.                 override;
  35.                 procedure Resize;
  36.                 override;
  37.                 procedure DoItemWhere (er: eventRecord; item: integer);
  38.                 override;
  39.                 procedure DoKey (modifiers: integer; ch: char; code: integer);
  40.                 override;
  41.                 procedure DoActivateDeactivate (activate: boolean);
  42.                 override;
  43.             end;
  44.  
  45.     const
  46.         status_ldef = 128;
  47.         but1_item = 1;
  48.         but2_item = 2;
  49.         but3_item = 3;
  50.         outline_item = 4;
  51.         line1_item = 5;
  52.         line2_item = 6;
  53.         list_item = 7;
  54.  
  55.     var
  56.         status: StatusObject;
  57.         dblclickproc: procPtr;
  58.         thelist: listHandle;
  59.         outlined_button: integer;
  60.         cheat_v: integer;
  61.  
  62.     procedure SetShowStatus (themenu, theitem: integer);
  63.     begin
  64.         SetIDItemEnable(themenu, theitem, FrontWindow <> status.window);
  65.     end;
  66.  
  67.     procedure ShowStatus;
  68.     begin
  69.         SelectWindow(status.window);
  70.         ShowWindow(status.window);
  71.     end;
  72.  
  73.     procedure InitOOStatus (HandleStatusCommand: procPtr);
  74.     begin
  75.         cheat_v := -1;
  76.         outlined_button := 0;
  77.         dblclickproc := HandleStatusCommand;
  78.         SetFBoth(CStatus, @ShowStatus, @SetShowStatus);
  79.         new(status);
  80.         status.Create(status_dialog_id);
  81.     end;
  82.  
  83.     procedure FinishOOStatus;
  84.     begin
  85.         status.Destroy;
  86.     end;
  87.  
  88.     procedure StatusObject.DoClose;
  89.     begin
  90.         HideWindow(window);
  91.     end;
  92.  
  93.     procedure DrawStatus (dp: dialogPtr; item: integer);
  94.         var
  95.             f: longInt;
  96.     begin
  97.         LUpdate(dp^.visRgn, thelist);
  98.         DrawGrowIcon(dp);
  99.     end;
  100.  
  101.     procedure DrawOutline (dp: dialogPtr; item: integer);
  102.         var
  103.             r: rect;
  104.             fi: StatusObject;
  105.     begin
  106.         SetPort(dp);
  107.         GetDItemRect(dp, outline_item, r);
  108.         if (r.right <> 0) and (outlined_button <> 0) then begin
  109.             fi := StatusObject(GetWObject(dp));
  110.             PenSize(3, 3);
  111.             if not ControlEnabled(dp, outlined_button) or not fi.is_active then begin
  112.                 PenPat(gray);
  113.                 FrameRoundRect(r, 16, 16);
  114.                 PenPat(black);
  115.             end
  116.             else
  117.                 FrameRoundRect(r, 16, 16);
  118.         end;
  119.     end;
  120.  
  121.     procedure StatusObject.DoActivateDeactivate (activate: boolean);
  122.     begin
  123.         inherited DoActivateDeactivate(activate);
  124.         DrawOutline(window, outline_item);
  125.     end;
  126.  
  127.     procedure SetOutline (item: integer);
  128.         var
  129.             r, r2: rect;
  130.     begin
  131.         SetPort(status.window);
  132.         GetDItemRect(status.window, outline_item, r);
  133.         EraseRect(r);
  134.         if item = 0 then
  135.             SetRect(r2, 0, 0, 0, 0)
  136.         else begin
  137.             GetDItemRect(status.window, item, r2);
  138.             InsetRect(r2, -4, -4);
  139.         end;
  140.         SetDItemRect(status.window, outline_item, r2);
  141.         DrawControls(status.window);
  142.         outlined_button := item;
  143.         DrawOutline(status.window, outline_item);
  144.     end;
  145.  
  146.     procedure SetDControlRect (dp: dialogPtr; item: integer; r: rect);
  147.         var
  148.             kind: integer;
  149.             h: handle;
  150.             rr: rect;
  151.     begin
  152.         SetDItemRect(dp, item, r);
  153.         GetDItem(dp, item, kind, h, rr);
  154.         MoveControl(controlHandle(h), r.left, r.top);
  155.         SizeControl(controlHandle(h), r.right - r.left, r.bottom - r.top);
  156.         GetDItemRect(dp, item, rr);
  157.     end;
  158.  
  159.     procedure StatusObject.Resize;
  160.         var
  161.             pr, b1, r: rect;
  162.             dist: integer;
  163.     begin
  164.         pr := window^.portrect;
  165.         GetDItemRect(window, but1_item, b1);
  166.         dist := (pr.right - 16 - pr.left - 3 * (b1.right - b1.left)) div 4;
  167.         b1.right := b1.right - b1.left + dist;
  168.         b1.left := dist;
  169.         SetDControlRect(window, but1_item, b1);
  170.         growRect.left := 3 * (b1.right - b1.left) + 38;
  171.         r := b1;
  172.         r.right := pr.right - 16 - b1.left;
  173.         r.left := pr.right - 16 - b1.right;
  174.         SetDControlRect(window, but3_item, r);
  175.         r.left := (r.left + b1.left) div 2;
  176.         r.right := (r.right + b1.right) div 2;
  177.         SetDControlRect(window, but2_item, r);
  178.         GetDItemRect(window, line1_item, r);
  179.         r.left := pr.left;
  180.         r.right := pr.right;
  181.         SetDControlRect(window, line1_item, r);
  182.         growRect.top := r.bottom + 64;
  183.         GetDItemRect(window, line2_item, r);
  184.         r.left := pr.left;
  185.         r.right := pr.right;
  186.         SetDControlRect(window, line2_item, r);
  187.         r.left := -1;
  188.         r.right := pr.right + 1;
  189.         r.top := r.top + 1;
  190.         r.bottom := pr.bottom - 15;
  191.         SetDItemRect(window, list_item, r);
  192.         thelist^^.rView := r;
  193.         LSize(r.right - r.left - 16, r.bottom - r.top, thelist);
  194.         InvalRect(window^.portRect);
  195.         SetOutline(outlined_button);
  196.         inherited Resize;
  197.     end;
  198.  
  199.     procedure DoSetButtons (i1: integer; b1: boolean; i2: integer; b2: boolean; i3: integer; b3: boolean; def: integer);
  200.         procedure DSB (but, index: integer; on: boolean);
  201.             var
  202.                 ch: ControlHandle;
  203.                 s1, s2: str255;
  204.                 hilite: integer;
  205.         begin
  206.             ch := GetDControlHandle(status.window, but);
  207.             if index <> 0 then begin
  208.                 s1 := GetIndexedString(statusButtonsStrhID, index);
  209.                 GetCTitle(ch, s2);
  210.                 if s1 <> s2 then
  211.                     SetCTitle(ch, s1);
  212.             end;
  213.             hilite := 255 * ord(not on);
  214.             if ch^^.contrlHilite <> hilite then
  215.                 HiliteControl(ch, 255 * ord(not on));
  216.         end;
  217.     begin
  218.         DSB(but1_item, i1, b1);
  219.         DSB(but2_item, i2, b2);
  220.         DSB(but3_item, i3, b3);
  221.         if def <> outlined_button then
  222.             SetOutline(def);
  223.     end;
  224.  
  225.     procedure SetNoButtons;
  226.     begin
  227.         DoSetButtons(statusAbortStrIndex, false, statusConnectStrIndex, false, statusToFrontStrIndex, false, 0);
  228.     end;
  229.  
  230.     procedure SetSomeButtons (data: longInt; var celldata: cellRecord);
  231.         var
  232.             rs: requestState;
  233.             out: boolean;
  234.     begin
  235.         out := requestDirection(celldata.sicn1index - 1) = RD_Outgoing;
  236.         rs := requestState(celldata.sicn2index - 1);
  237.         case rs of
  238.             RS_request: 
  239.                 DoSetButtons(statusAbortStrIndex, out, statusConnectStrIndex, not out, statusToFrontStrIndex, false, 2 - ord(out));
  240.             RS_connecting: 
  241.                 if out then
  242.                     DoSetButtons(statusAbortStrIndex, true, statusRingAgainStrIndex, true, statusToFrontStrIndex, false, 2)
  243.                 else
  244.                     DoSetButtons(statusAbortStrIndex, false, statusConnectStrIndex, false, statusToFrontStrIndex, false, 0);
  245.             RS_connected: 
  246.                 DoSetButtons(statusHangUpStrIndex, true, 0, false, statusToFrontStrIndex, true, 3);
  247.             RS_disconnected: 
  248.                 if data = 0 then
  249.                     DoSetButtons(statusRemoveStrIndex, true, statusConnectStrIndex, true, statusToFrontStrIndex, false, 2)
  250.                 else
  251.                     DoSetButtons(statusRemoveStrIndex, false, statusConnectStrIndex, false, statusToFrontStrIndex, true, 3);
  252.             RS_failed: 
  253.                 DoSetButtons(statusRemoveStrIndex, true, statusConnectStrIndex, true, statusToFrontStrIndex, false, 2);
  254.             otherwise
  255.                 ;
  256.         end;
  257.     end;
  258.  
  259.     procedure GetLineInfo (v: integer; var data: longInt; var celldata: cellRecord);
  260.         var
  261.             c: cell;
  262.             datalen: integer;
  263.     begin
  264.         c.v := v;
  265.         c.h := 1;
  266.         datalen := SizeOf(data);
  267.         LGetCell(@data, datalen, c, thelist);
  268.         if datalen = SizeOf(data) then begin
  269.             c.h := 0;
  270.             datalen := SizeOf(celldata);
  271.             LGetCell(@celldata, datalen, c, thelist);
  272.         end;
  273.     end;
  274.  
  275.     procedure SetButtons;
  276.         var
  277.             c: cell;
  278.             data: longInt;
  279.             celldata: cellRecord;
  280.     begin
  281.         c.h := 0;
  282.         c.v := 0;
  283.         if LGetSelect(true, c, thelist) then begin
  284.             GetLineInfo(c.v, data, celldata);
  285.             SetSomeButtons(data, celldata);
  286.         end
  287.         else
  288.             SetNoButtons;
  289.     end;
  290.  
  291.     procedure StatusObject.Destroy;
  292.         var
  293.             h: handle;
  294.     begin
  295.         h := NewHandle(0);
  296.         GetWindowPos(h);
  297.         SetPrefsResource(savedWindowresType, resid, h);
  298.  
  299.         LDispose(thelist);
  300.     end;
  301.  
  302.     procedure StatusObject.Create (id: integer);
  303.         var
  304.             k: integer;
  305.             h: handle;
  306.             r: rect;
  307.             view, bounds: rect;
  308.             cSize: point;
  309.             wasvisible: boolean;
  310.             resfile: integer;
  311.     begin
  312.         inherited Create(id);
  313.         draw_grow_icon := true;
  314.         SetPort(window);
  315.         TextFont(geneva);
  316.         GetDItem(window, list_item, k, h, r);
  317.         SetDItem(window, list_item, k, handle(@DrawStatus), r);
  318.         GetDItem(window, outline_item, k, h, r);
  319.         SetDItem(window, outline_item, k, handle(@DrawOutline), r);
  320.         SetRect(view, 0, 0, 10, 10); { irrelevent }
  321.         SetRect(bounds, 0, 0, 2, 0);
  322.         SetPt(cSize, 1000, 0);
  323.         thelist := LNew(view, bounds, cSize, status_ldef, window, true, true, false, true);
  324.         thelist^^.selFlags := lOnlyOne;
  325.  
  326.         SetButtons;
  327.  
  328.         resfile := GetPrefsResource(savedWindowResType, id, h);
  329.         if h <> nil then
  330.             SetWindowPos(h, wasvisible)
  331.         else
  332.             wasvisible := false;
  333.  
  334.         if resfile <> -1 then
  335.             CloseResFile(resfile);
  336.  
  337.         Resize;
  338.  
  339.         if wasvisible then
  340.             ShowWindow(window);
  341.     end;
  342.  
  343.     procedure CallDoCommand (data: longInt; sc: statusCommands; var s: string; p: ptr);
  344.     inline
  345.         $205F, $4E90;
  346.  
  347.     procedure DoStatusCommand (v: integer; item: integer);
  348.         var
  349.             data: longInt;
  350.             celldata: cellRecord;
  351.             sc: statusCommands;
  352.     begin
  353.         sc := statusCommands(item);
  354.         GetLineInfo(v, data, celldata);
  355.         if data = 0 then begin
  356.             if sc = SC_Connect then begin
  357.                 cheat_v := v;
  358.                 TalkTo(celldata.str2);
  359.             end
  360.             else begin
  361.                 LDelRow(1, v, thelist);
  362.                 if prefs.close_status then
  363.                     if thelist^^.databounds.bottom = 0 then
  364.                         status.DoClose;
  365.                 SetButtons;
  366.             end;
  367.         end
  368.         else
  369.             CallDoCommand(data, sc, celldata.str2, dblclickproc);
  370.     end;
  371.  
  372.     procedure StatusObject.DoItemWhere (er: eventRecord; item: integer);
  373.         var
  374.             c: cell;
  375.             data: longInt;
  376.             datalen: integer;
  377.     begin
  378.         case item of
  379.             list_item:  begin
  380.                 SetPort(window);
  381.                 GlobalToLocal(er.where);
  382.                 if LClick(er.where, er.modifiers, thelist) then begin
  383.                     c := LLastClick(thelist);
  384.                     DoStatusCommand(c.v, outlined_button);
  385.                 end;
  386.                 SetButtons;
  387.             end;
  388.             but1_item, but2_item, but3_item:  begin
  389.                 c.h := 0;
  390.                 c.v := 0;
  391.                 if LGetSelect(true, c, thelist) then
  392.                     DoStatusCommand(c.v, item);
  393.             end;
  394.             otherwise
  395.                 ;
  396.         end;
  397.     end;
  398.  
  399.     procedure SelectRow (v: integer);
  400.         var
  401.             c: cell;
  402.     begin
  403.         c.h := 0;
  404.         c.v := 0;
  405.         if LGetSelect(true, c, thelist) then
  406.             LSetSelect(false, c, thelist);
  407.         c.v := v;
  408.         LSetSelect(true, c, thelist);
  409.         SetButtons;
  410.     end;
  411.  
  412.     procedure StatusObject.DoKey (modifiers: integer; ch: char; code: integer);
  413.         var
  414.             c: cell;
  415.             data: longInt;
  416.             datalen, v, vm: integer;
  417.             didit: boolean;
  418.             celldata: cellRecord;
  419.             h: handle;
  420.             wasvis: boolean;
  421.     begin
  422.         didit := false;
  423.         c.h := 0;
  424.         c.v := 0;
  425.         if LGetSelect(true, c, thelist) then
  426.             v := c.v
  427.         else
  428.             v := -1;
  429.         vm := thelist^^.dataBounds.bottom;
  430.         case ch of
  431.             cr, enter:  begin
  432.                 if outlined_button <> 0 then begin
  433.                     if c.v >= 0 then begin
  434.                         DoStatusCommand(v, outlined_button);
  435.                         didit := true;
  436.                     end;
  437.                 end;
  438.             end;
  439.             upArrow, downArrow:  begin
  440.                 if vm > 0 then begin
  441.                     case 8 * ord(ch = upArrow) + 4 * ord(v = -1) + 2 * ord(v > 0) + ord(v < vm - 1) of
  442.                         1, 3:  { down, not last }
  443.                             v := v + 1;
  444.                         10, 11:  { up, not first }
  445.                             v := v - 1;
  446.                         8, 9, 4, 5, 6, 7:  { up&first OR down&no sel }
  447.                             v := 0;
  448.                         0, 2, 12, 13, 14, 15: { down&last OR up&no sel }
  449.                             v := vm - 1;
  450.                     end;
  451.                     SelectRow(v);
  452.                     didit := true;
  453.                 end;
  454.             end;
  455.             'a'..'z', 'A'..'Z':  begin
  456.                 v := 0;
  457.                 while v < vm do begin
  458.                     GetLineInfo(v, data, celldata);
  459.                     if (length(celldata.str2) > 0) & (UpCase(celldata.str2[1]) = UpCase(ch)) then begin
  460.                         SelectRow(v);
  461.                         didit := true;
  462.                         leave;
  463.                     end;
  464.                     v := v + 1;
  465.                 end;
  466.             end;
  467.             otherwise
  468.                 ;
  469.         end;
  470.         if not didit then
  471.             SysBeep(1);
  472.     end;
  473.  
  474.     function FindData (data: longInt; var c: cell): boolean;
  475.         var
  476.             ldata: longInt;
  477.             datalen: integer;
  478.     begin
  479.         FindData := false;
  480.         c.h := 1;
  481.         c.v := 0;
  482.         while (c.v < thelist^^.dataBounds.bottom) do begin
  483.             datalen := SizeOf(ldata);
  484.             LGetCell(@ldata, datalen, c, thelist);
  485.             if (datalen = 4) and (ldata = data) then begin
  486.                 FindData := true;
  487.                 leave;
  488.             end;
  489.             c.v := c.v + 1;
  490.         end;
  491.     end;
  492.  
  493.     procedure SetEntry (data: univ longInt; rd: requestDirection; rs: requestState; title: str255);
  494.         var
  495.             c, c2: cell;
  496.             celldata: cellRecord;
  497.             s: str255;
  498.             secs: longInt;
  499.             datalen: integer;
  500.     begin
  501.         if not FindData(data, c) then begin
  502.             if cheat_v >= 0 then
  503.                 c.v := cheat_v
  504.             else
  505.                 c.v := LAddRow(1, maxInt, thelist);
  506.             c.h := 1;
  507.             LSetCell(@data, SizeOf(data), c, thelist);
  508.             celldata.sicn1id := 200;
  509.             celldata.sicn1index := 1;
  510.             celldata.sicn2id := 300;
  511.             celldata.sicn2index := 1;
  512.             GetDateTime(secs);
  513.             IUTimeString(secs, false, s);
  514.             celldata.str1 := s;
  515.             celldata.str2 := title;
  516.         end
  517.         else begin
  518.             datalen := SizeOf(celldata);
  519.             c.h := 0;
  520.             LGetCell(@celldata, datalen, c, thelist);
  521.         end;
  522.         cheat_v := -1;
  523.         if rd <> RD_whatever then
  524.             celldata.sicn1index := ord(rd) + 1;
  525.         if rs <> RS_whatever then
  526.             celldata.sicn2index := ord(rs) + 1;
  527.         if title <> '' then
  528.             celldata.str2 := title;
  529.         c.h := 0;
  530.         LSetCell(@celldata, SizeOf(celldata) - SizeOf(celldata.str2) + 1 + length(celldata.str2), c, thelist);
  531.         c2.h := 0;
  532.         c2.v := 0;
  533.         if LGetSelect(true, c2, thelist) then begin
  534.             if c2.v = c.v then
  535.                 SetButtons;
  536.         end
  537.         else begin
  538.             LSetSelect(true, c, thelist);
  539.             SetButtons;
  540.         end;
  541.     end;
  542.  
  543.     procedure RemoveEntry (data: univ longInt);
  544.         var
  545.             c, c2: cell;
  546.             celldata: cellRecord;
  547.             datalen: integer;
  548.     begin
  549.         if FindData(data, c) then begin
  550.             c.h := 0;
  551.             datalen := SizeOf(celldata);
  552.             LGetCell(@celldata, datalen, c, thelist);
  553.             case requestState(celldata.sicn2index - 1) of
  554.                 rs_request, rs_connecting: 
  555.                     celldata.sicn2index := ord(rs_failed) + 1;
  556.                 rs_connected: 
  557.                     celldata.sicn2index := ord(rs_disconnected) + 1;
  558.                 otherwise
  559.                     ;
  560.             end;
  561.             LSetCell(@celldata, datalen, c, thelist);
  562.             c.h := 1;
  563.             data := 0;
  564.             LSetCell(@data, SizeOf(data), c, thelist);
  565.             c2.h := 0;
  566.             c2.v := 0;
  567.             if LGetSelect(true, c2, thelist) then
  568.                 if c2.v = c.v then
  569.                     SetButtons;
  570.         end;
  571.     end;
  572.  
  573. end.