home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 502b.lha / PCQ_v1.2 / PCQ_Examples / examples.LZH / Examples / DeadKeysPlus.p < prev    next >
Text File  |  1991-04-04  |  6KB  |  251 lines
  1. Program DeadKeysPlus;
  2.  
  3. {
  4.     This program is the same as an older program called DeadKeys,
  5. which used the DeadKeyConvert() and RawKeyConvert() functions to
  6. get keystrokes in a very compatible way.  To that I have added
  7. mostly useless menus, which are an example of the use of the
  8. BuildMenu routines.  These, in turn, exercise the Intuition menu
  9. functions.
  10.     To make a long story short, if you are looking for an example
  11. of DeadKeyConvert() or BuildMenu it's in here somewhere.
  12.  
  13.     Although you would certainly want the code to be more modular
  14. and you would need to design a data structure, this is the barest
  15. bones of a text editor.
  16. }
  17.  
  18. {$I "Include:Exec/Interrupts.i"}
  19. {$I "Include:Exec/Libraries.i"}
  20. {$I "Include:Exec/Ports.i"}
  21. {$I "Include:Exec/IO.i"}
  22. {$I "Include:Exec/Devices.i"}
  23. {$I "Include:Utils/IOUtils.i"}
  24. {$I "Include:Intuition/Intuition.i"}
  25. {$I "Include:Devices/InputEvent.i"}
  26. {$I "Include:Utils/ConsoleUtils.i"}
  27. {$I "Include:Utils/ConsoleIO.i"}
  28. {$I "Include:Utils/DeadKeyConvert.i"}
  29. {$I "Include:Utils/BuildMenu.i"}
  30.  
  31. var
  32.     w  : WindowPtr;
  33.     s  : Address;
  34.  
  35. Function OpenTheScreen : Boolean;
  36. var
  37.     ns : NewScreenPtr;
  38. begin
  39.     new(ns);
  40.     with ns^ do begin
  41.     LeftEdge := 0;
  42.     TopEdge  := 0;
  43.     Width    := 640;
  44.     Height   := 200;
  45.     Depth    := 2;
  46.     DetailPen := 3;
  47.     BlockPen  := 2;
  48.     ViewModes := 32768;
  49.     SType     := CUSTOMSCREEN_f;
  50.     Font      := Nil;
  51.     DefaultTitle := "Press ESC or choose Quit to End the Demonstration";
  52.     Gadgets   := nil;
  53.     CustomBitMap := nil;
  54.     end;
  55.     s := OpenScreen(ns);
  56.     dispose(ns);
  57.     OpenTheScreen := s <> nil;
  58. end;
  59.  
  60. Function OpenTheWindow : Boolean;
  61. var
  62.     nw : NewWindowPtr;
  63. begin
  64.     new(nw);
  65.     with nw^ do begin
  66.     LeftEdge := 0;
  67.     TopEdge := 2;
  68.     Width := 640;
  69.     Height := 198;
  70.  
  71.     DetailPen := -1;
  72.     BlockPen  := -1;
  73.     IDCMPFlags := RAWKEY_f + MENUPICK_f;
  74.     Flags := SMART_REFRESH + ACTIVATE +
  75.             BORDERLESS + BACKDROP;
  76.     FirstGadget := Nil;
  77.     CheckMark := Nil;
  78.     Title := "";
  79.     Screen := s;
  80.     BitMap := Nil;
  81.     MinWidth := 0;
  82.     MaxWidth := -1;
  83.     MinHeight := 0;
  84.     MaxHeight := -1;
  85.     WType := CUSTOMSCREEN_f;
  86.     end;
  87.  
  88.     w := OpenWindow(nw);
  89.     dispose(nw);
  90.     OpenTheWindow := w <> nil;
  91. end;
  92.  
  93. var
  94.     IMessage    : IntuiMessagePtr;
  95.     Buffer    : Array [0..9] of Char;
  96.     Length    : Integer;
  97.     Leave    : Boolean;
  98.     WriteReq    : IOStdReqPtr;
  99.     WritePort    : MsgPortPtr;
  100.  
  101. Function AddTheMenus : Boolean;
  102. begin
  103.     InitializeMenu(w);
  104.     NewMenu("Project");
  105.     NewItem("New ",'N');
  106.     NewItem("Load",'L');
  107.     NewItem("Save",'S');
  108.     NewItem("Quit",'Q');
  109.     NewMenu("Action");
  110.     NewItem("Defoliate      ",'D');
  111.     NewItem("Repack Bearings",'R');
  112.     NewItem("Mince        >>",'\0');
  113.     NewSubItem("Slice   ", '1');
  114.     NewSubItem("Dice    ", '2');
  115.     NewSubItem("Julienne", '3');
  116.     NewItem("Floss          ",'F');
  117.     AttachMenu;
  118.     AddTheMenus := True;
  119. end;
  120.  
  121. Procedure LoseTheMenus;
  122. begin
  123.     DetachMenu;
  124. end;
  125.  
  126. Procedure OpenEverything;
  127. var
  128.     Error : Short;
  129. begin
  130.     OpenConsoleDevice;
  131.     if OpenTheScreen then begin
  132.     if OpenTheWindow then begin
  133.         if AddTheMenus then begin
  134.         WritePort := CreatePort(Nil, 0);
  135.         if WritePort <> Nil then begin
  136.             WriteReq := CreateStdIO(WritePort);
  137.             if WriteReq <> Nil then begin
  138.             WriteReq^.io_Data := Address(w);
  139.             WriteReq^.io_Length := SizeOf(Window);
  140.             Error := OpenDevice("console.device", 0,
  141.                         IORequestPtr(WriteReq), 0);
  142.             if Error = 0 then
  143.                 return;
  144.             DeleteStdIO(WriteReq);
  145.             Writeln('Could not open the console.device');
  146.             end else
  147.             Writeln('Could not allocate memory');
  148.             DeletePort(WritePort);
  149.         end else
  150.             Writeln('Could not allocate a message port');
  151.         LoseTheMenus;
  152.         end else
  153.         Writeln('Could not attach the menus');
  154.         CloseWindow(w);
  155.     end else
  156.         Writeln('Could not open the window');
  157.     CloseScreen(s);
  158.     end else
  159.     Writeln('Could not open the screen');
  160.     CloseConsoleDevice;
  161.     Exit(20);
  162. end;
  163.  
  164. Procedure CloseEverything;
  165. begin
  166.     CloseDevice(IORequestPtr(WriteReq));
  167.     DeleteStdIO(WriteReq);
  168.     DeletePort(WritePort);
  169.     LoseTheMenus;
  170.     CloseWindow(w);
  171.     CloseScreen(s);
  172.     CloseConsoleDevice;
  173. end;
  174.  
  175. Procedure ConvertControl;
  176. begin
  177.     case Ord(Buffer[0]) of
  178.       8 : ConPutStr(WriteReq, "\b\cP");
  179.      13 : ConPutStr(WriteReq, "\n\cL");
  180.      127 : ConPutStr(WriteReq, "\cP");
  181.     else
  182.     ConPutChar(WriteReq, Buffer[0]);
  183.     end;
  184. end;
  185.  
  186. Procedure ConvertTwoChar;
  187. begin
  188.     case Buffer[1] of
  189.       'A'..'D' : ConWrite(WriteReq, Adr(Buffer), 2);
  190.     end;
  191. end;
  192.  
  193. begin
  194.     OpenEverything;
  195.     Leave := False;
  196.     repeat
  197.     IMessage := IntuiMessagePtr(WaitPort(w^.UserPort));
  198.     IMessage := IntuiMessagePtr(GetMsg(w^.UserPort));
  199.     if IMessage^.Class = RAWKEY_f then begin
  200.         if IMessage^.Code < 128 then begin { Key Down }
  201.         Length := DeadKeyConvert(IMessage, Adr(Buffer), 10, Nil);
  202.         case Length of
  203.           -MaxInt..-1 : ConWrite(WriteReq, "DeadKeyConvert error",20);
  204.            1 : if Buffer[0] = '\e' then
  205.                Leave := True
  206.             else begin
  207.                 if (Buffer[0] < ' ') or
  208.                 (Ord(Buffer[0]) > 126) then
  209.                 ConvertControl
  210.                 else begin
  211.                 Buffer[2] := Buffer[0];
  212.                 Buffer[0] := '\c';
  213.                 Buffer[1] := '@'; { Insert }
  214.                 ConWrite(WriteReq, Adr(Buffer), 3);
  215.                 end;
  216.             end;
  217.            2 : ConvertTwoChar;
  218.         end;
  219.         end;
  220.     end else if IMessage^.Class = MENUPICK_f then begin
  221.         if IMessage^.Code = MENUNULL then
  222.         ConWrite(WriteReq, "\nNo item", 8)
  223.         else begin
  224.         Buffer[0] := Chr(MenuNum(IMessage^.Code) + Ord('0'));
  225.         Buffer[1] := '\n';
  226.         ConWrite(WriteReq, "\nMenu Number: ", 14);
  227.         ConWrite(WriteReq, Adr(Buffer), 2);
  228.         Buffer[0] := Chr(ItemNum(IMessage^.Code) + Ord('0'));
  229.         ConWrite(WriteReq, "Item Number: ", 13);
  230.         ConWrite(WriteReq, Adr(Buffer), 2);
  231.         if SubNum(IMessage^.Code) <> NOSUB then begin
  232.             Buffer[0] := Chr(SubNum(IMessage^.Code) + Ord('0'));
  233.             ConWrite(WriteReq, "Sub Number : ", 13);
  234.             ConWrite(WriteReq, Adr(Buffer), 2);
  235.         end;
  236.         if (MenuNum(IMessage^.Code) = 0) and
  237.             (ItemNum(IMessage^.Code) = 3) then
  238.             Leave := True;
  239.         end;
  240.     end else { Must be CloseWindow }
  241.         Leave := True;
  242.     ReplyMsg(MessagePtr(IMessage));
  243.     until Leave;
  244.     Forbid;
  245.     repeat
  246.     IMessage := IntuiMessagePtr(GetMsg(w^.UserPort));
  247.     until IMessage = nil;
  248.     Permit;
  249.     CloseEverything;
  250. end.
  251.