{--------------------------------------------------------------------------

                     HighSpeed Pascal for the Amiga

                          SPEAKER'S CORNER DEMO

                  Programmed by Martin Eskildsen 1991

                  Copyright (c) 1991 by D-House I ApS
                         All rights reserved


  Version : Date (dd.mm.yy) : Comment
  -----------------------------------
    1.00 : 06.11.91 : First version
    1.10 : 22.04.92 : Wait() fixed

--------------------------------------------------------------------------}

program SpeakersCorner;

uses Exec, Graphics, Intuition, Narrator, Speech, MenuUtil, Init;

const
  version          = '1.00';	{ Program's version }

  Rev              = 0;		{ Library revision required }

  MaxInputLen      = 254;	{ Number of characters in input buffer }

  InitMsg          = 'Speaker''s Corner';  { What to say at boot }

  InputSurroundBox : array [1..10] of integer = 
                     (0,0, 325,0, 325,13, 0,13, 0,1);
  			{ Box surrounding the input string }

  SpeakSurroundBox : array [1..10] of integer =
                     (0,0, 195,0, 195,11, 0,11, 0,1);
  			{ Box surrounding the "I want to speak!" gadget }


type
  InputStr    = string[MaxInputLen];	{ The input buffer }

var
  window      : pWindow;	{ The program's window }
  menu        : pMenu;		{ The main menu }
  input       : InputStr;	{ The input buffer }
  Undo        : InputStr;	{ Undo buffer for input string }

  Font          : tTextAttr;	{ The font used for all text }

  InputBorder   : tBorder;	{ Setup for border around input box }
  InputStrRec   : tStringInfo;	{ Setup for the editable string field }
  InputTextRec  : tIntuiText;	{ Setup for the text connected to string field }
  InputGadget   : tGadget;	{ Assembly of the above }

  SpeakBorder   : tBorder;	{ Border around "I want to speak!" gadget }
  SpeakTextRec  : tIntuiText;	{ "I want to speak!" }
  SpeakGadget   : tGadget;	{ Assembly of the above }

  PropTexts     : array [0..3] of tIntuiText;
  PropImages    : array [0..3] of tImage;
  PropInfo      : array [0..3] of tPropInfo;
  PropGadgets   : array [0..3] of tGadget;

  AboutReq      : array [1..12] of tIntuiText;  { Texts for "About" requester }
  AboutReqOk    : tIntuiText;                   { "Ok" in "About" requester }

{ Set up all gadgets for main window }
function CreateGadgets : pointer;
var i : 0..3;

  { This func adjusts the input value n belonging to [min..max] to fit }
  { the [0..65535] range for the proportional gadgets }
  function MakeValue(n, min, max : System.Word) : System.Word;
  begin
    MakeValue := Trunc(65535 / (max-min) * n)
  end;

begin
  Undo := #0;

{--- Font information ---}
  with Font do begin
    ta_Name  := CstrConstPtr('topaz.font');
    ta_Ysize := TOPAZ_EIGHTY;
    ta_Style := 0;
    ta_Flags := 0
  end;

{--- Input string gadget setup ---}
  with InputBorder do begin
    LeftEdge   := -3;           { Position relative to gadget box }
    TopEdge    := -3;
    FrontPen   := 1;
    BackPen    := 0;
    DrawMode   := JAM1;
    Count      := SizeOf(InputSurroundBox) div SizeOf(Integer) div 2;
    XY         := @InputSurroundBox;
    NextBorder := NIL
  end;

  Input := InitMsg + #0;        { Put the intro message in the string gadget }

  with InputStrRec do begin
    Buffer     := @Input[1];
    UndoBuffer := @Undo[1];
    BufferPos  := 0;
    MaxChars   := MaxInputLen + 1;      { + 1 to hold #0 }
    DispPos    := 0;
    UndoPos    := 0;                    { The below are maintained by }
    NumChars   := Length(Input);        { Intuition }
    DispCount  := 0;
    Cleft      := 0;
    Ctop       := 0;
    {$ifdef WORKBENCH_2}
    Extension  := NIL;
    {$else}
    LayerPtr   := NIL;
    {$endif}
    LongInt_   := 0;
    AltKeyMap  := NIL
  end;

  with InputTextRec do begin
    FrontPen  := 1;
    BackPen   := 0;
    DrawMode  := JAM1;
    LeftEdge  := 0;              { Position relative to string gadget box }
    TopEdge   := -8-3-2;
    ITextFont := @Font;          { The font to use }
    IText     := CstrConstPtr('Input String');
    NextText  := NIL
  end;

  with InputGadget do begin
    NextGadget    := NIL;               { This gadget will be last in chain }
    LeftEdge      := 8 + 3;
    TopEdge       := 120;
    Width         := 320;
    Height        := 10;
    Flags         := GADGHCOMP;
    Activation    := RELVERIFY;
    GadgetType    := STRGADGET;
    GadgetRender  := @InputBorder;
    SelectRender  := NIL;
    GadgetText    := @InputTextRec;
    MutualExclude := 0;
    SpecialInfo   := @InputStrRec;
    GadgetID      := 0;
    UserData      := NIL
  end;

{--- Speak gadget ---}
  with SpeakBorder do begin
    LeftEdge   := -1;
    TopEdge    := -1;
    FrontPen   := 1;
    BackPen    := 0;
    DrawMode   := JAM1;
    Count      := SizeOf(SpeakSurroundBox) div SizeOf(Integer) div 2;
    XY         := @SpeakSurroundBox;
    NextBorder := NIL
  end;

  with SpeakTextRec do begin
    FrontPen  := 1;
    BackPen   := 0;
    DrawMode  := JAM1;
    LeftEdge  := 1;
    TopEdge   := 1;
    ITextFont := @Font;
    IText     := CstrConstPtr('I want to say something!');
    NextText  := NIL
  end;

  with SpeakGadget do begin
    NextGadget    := @InputGadget;
    LeftEdge      := 10;
    TopEdge       := 150;
    Width         := 192 + 1 + 1;
    Height        := 8 + 1 + 1;
    Flags         := GADGHCOMP;
    Activation    := RELVERIFY or GADGIMMEDIATE;
    GadgetType    := BOOLGADGET;
    GadgetRender  := @SpeakBorder;
    SelectRender  := NIL;
    GadgetText    := @SpeakTextRec;
    MutualExclude := 0;
    SpecialInfo   := NIL;
    GadgetID      := 0;
    UserData      := NIL
  end;

{--- Proportional Gadgets---}
  with PropInfo[0] do begin
    Flags      := AUTOKNOB or FREEHORIZ;
    HorizPot   := 0;
    VertPot    := 0;
    HorizBody  := $1FFF;
    VertBody   := $1FFF;
    CWidth     := 0;				{ Intuition property }
    CHeight    := 0;
    HPotRes    := 0;
    VPotRes    := 0;
    LeftBorder := 0;
    TopBorder  := 0
  end;

  with PropTexts[0] do begin
    FrontPen  := 1;
    BackPen   := 0;
    DrawMode  := JAM1;
    LeftEdge  := 0;
    TopEdge   := -8-2;
    ITextFont := @Font;
    IText     := NIL;
    NextText  := NIL
  end;
  
  with PropImages[0] do begin           { Should NOT be initialized }
  end;                                  { Intuition uses it }

  with PropGadgets[0] do begin
    NextGadget    := @SpeakGadget;
    LeftEdge      := 7;
    TopEdge       := 23;
    Width         := 327;
    Height        := 10;
    Flags         := GADGHCOMP or GADGIMAGE;
    Activation    := RELVERIFY or GADGIMMEDIATE;
    GadgetType    := PROPGADGET;
    GadgetRender  := NIL;
    SelectRender  := NIL;
    GadgetText    := NIL;
    MutualExclude := 0;
    SpecialInfo   := NIL;
    GadgetID      := 0;
    UserData      := NIL
  end;

  for i := 0 to 3 do begin
    PropGadgets[i] := PropGadgets[0];
    PropImages [i] := PropImages [0];
    PropTexts  [i] := PropTexts  [0];
    PropInfo   [i] := PropInfo   [0];
    with PropGadgets[i] do begin
      if i > 0 then NextGadget := @PropGadgets[i-1];
      TopEdge	   := PropGadgets[0].TopEdge + i*22;
      GadgetRender := @PropImages[i];
      GadgetText   := @PropTexts [i];
      SpecialInfo  := @PropInfo  [i]
    end;
    case i of
      0 : begin
            PropTexts[0].IText := CstrConstPtr('Sample Frequency');
            PropInfo[0].HorizPot := MakeValue(DEFFREQ, MINFREQ, MAXFREQ)
          end;
      1 : begin
            PropTexts[1].IText := CstrConstPtr('Rate');
            PropInfo[1].HorizPot := MakeValue(DEFRATE, MINRATE, MAXRATE)
          end;
      2 : begin
            PropTexts[2].IText := CstrConstPtr('Pitch');
            PropInfo[2].HorizPot := MakeValue(DEFPITCH, MINPITCH, MAXPITCH)
          end;
      3 : begin
            PropTexts[3].IText := CstrConstPtr('Volume');
            PropInfo[3].HorizPot := MakeValue(DEFVOL, MINVOL, MAXVOL)
          end
    end;  { case }
  end;

  CreateGadgets := @PropGadgets[3]
end;

{ Create a character-centred string. width is field width in characters }
function Center(s : string; width : byte) : string;
var i : byte;
begin
  for i := 1 to (width - length(s)) div 2 do s := ' ' + s;
  Center := s
end;

procedure SetUp;
var
  def : tNewWindow;     { Definition of window }
  m   : pMenu;          { Temporary used when constructing menu }
  i   : byte;
begin

  { Open the used libraries }

  IntuitionBase := pIntuitionBase(OpenLibrary('intuition.library', Rev));
  GfxBase       := pGfxBase      (OpenLibrary('graphics.library',  Rev));

  { First, define what the window should look like }

  with def do begin
    LeftEdge      := 0;
    TopEdge       := 0;
    Width         := 340;
    Height        := 170;
    DetailPen     := -1;
    BlockPen      := -1;
    Title         := CStrConstPtr('Speaker''s Corner version ' + version);
    Flags         := WINDOWCLOSE   or     { Add Close gadget, }
                     WINDOWDEPTH   or     { depth arrangement gadgets }
                     WINDOWDRAG    or     { and make it movable }
                     SMART_REFRESH or     { Save window in RAM }
                     ACTIVATE      or     { Activate it }
                     NOCAREREFRESH;       { Don't wanna hear of refreshes! }
    IDCMPFlags    := CLOSEWINDOW_  or     { But of user-clicks on Close }
                     MENUPICK      or     { ...menu selections and }
                     GADGETUP;            { ...released gadgets }
    Type_         := WBENCHSCREEN;        { Put window on workbench screen }
    FirstGadget   := CreateGadgets;       { The gadgets attached }
    CheckMark     := NIL;                 { Same checkmark as usual }
    Screen        := NIL;                 { Use workbench screen }
    BitMap        := NIL;                 { No bitmap }
    MinWidth      := Width;               { Dummies as we can't resize }
    MinHeight     := Height;              { this window }
    MaxWidth      := MinWidth;
    MaxHeight     := MinHeight
  end;

  { Then, construct the menus }

  InitMenu(menu, ' Info ');
  AddItem (menu, ' About Speaker''s Corner... ', ITEMENABLED or HIGHCOMP, 0, #0);
  AddItem (menu, '---------------------------', 0, 0, #0);
  AddItem (menu, ' Exit',                        ITEMENABLED or HIGHCOMP or COMMSEQ, 0, 'E');

  AddMenu (m, menu, ' Sex ');
  AddItem (m, '   Male       ', ITEMENABLED or HIGHCOMP or COMMSEQ or CHECKIT or CHECKED, $FFFE, 'M');
  AddItem (m, '   Female     ', ITEMENABLED or HIGHCOMP or COMMSEQ or CHECKIT,            $FFFD, 'F');

  AddMenu (m, menu, ' Mode ');
  AddItem (m, '   Human      ', ITEMENABLED or HIGHCOMP or COMMSEQ or CHECKIT or CHECKED, $FFFE, 'H');
  AddItem (m, '   Robot      ', ITEMENABLED or HIGHCOMP or COMMSEQ or CHECKIT,            $FFFD, 'R');

  { Open the window }

  window := OpenWindow(@def);
  if window = NIL then begin
    writeln('Can''t open window');
    halt(0)
  end;

  if SetMenuStrip(window, menu) and OpenSpeech then { nothing } ;

{--- "About..." requester ---}
  for i := 1 to 12 do                   { Create 12 lines }
    with AboutReq[i] do begin
      FrontPen  := 0;
      BackPen   := 1;
      DrawMode  := JAM1;
      LeftEdge  := 6;
      TopEdge   := i*10;
      ITextFont := @Font;
      if i < 12 then NextText  := @AboutReq[i+1] else NextText := NIL
    end;

  { Then insert the text into all 12 lines }
  AboutReq[ 1].IText := CstrConstPtr(Center('Speaker''s Corner version '+version, 36));
  AboutReq[ 2].IText := CstrConstPtr(Center('', 36));
  AboutReq[ 3].IText := CstrConstPtr(Center('a', 36));
  AboutReq[ 4].IText := CstrConstPtr(Center('HighSpeed Pascal', 36));
  AboutReq[ 5].IText := CstrConstPtr(Center('Demo Program', 36));
  AboutReq[ 6].IText := CstrConstPtr(Center('', 36));
  AboutReq[ 7].IText := CstrConstPtr(Center('Programming by', 36));
  AboutReq[ 8].IText := CstrConstPtr(Center('Martin Eskildsen/D-House I', 36));
  AboutReq[ 9].IText := CstrConstPtr(Center('', 36));
  AboutReq[10].IText := CstrConstPtr(Center('You can contact HiSoft on', 36));
  AboutReq[11].IText := CstrConstPtr(Center('Tel +44 525 718181', 36));
  AboutReq[12].IText := CstrConstPtr(Center('Fax +44 525 713716', 36));

  with AboutReqOk do begin
    FrontPen  := 0;
    BackPen   := 1;
    DrawMode  := JAM1;
    LeftEdge  := 6;                     { Position relative to gadget }
    TopEdge   := 3;
    ITextFont := @Font;
    IText     := CstrConstPtr('Ok');
    NextText  := NIL
  end;

  Say(InitMsg)                          { Say hi to the user }

end;

procedure GoodBye;
begin
  CloseSpeech;
  ClearMenuStrip(window);
  CloseWindow(window);
  CloseLibrary(pLibrary(IntuitionBase));  { Close Intuition }
  CloseLibrary(pLibrary(GfxBase))         { and Graphics }
end;

procedure MakeInputPascal;
begin
  input[0] := #255;                     { Assume input = 255 chars for Pos }
  input[0] := Chr(Pos(#0, input) - 1)   { But use only up to #0 }
end;

procedure About;
var bool : boolean;
begin
  bool := AutoRequest(window, @AboutReq[1], NIL, @AboutReqOk, 0, 0, 320, 155)
end;

function MakeValue(n, low, high : System.Word) : System.Word;
begin
  MakeValue := Trunc( n / (65535 / (high - low)) )
end;

procedure SelectLoop;
var
  dummy    : longint;
  Imessage : pIntuiMessage;   { The messages sent to this program }
  class    : integer;         { Message class }
  code     : integer;         { Message code }
  quit     : boolean;         { TRUE = done showing menu }
  mNum     : integer;         { Menu number selected }
  iNum     : integer;         { Item number selected }
  address  : pointer;         { Objects' address }
  ItemPtr  : pMenuItem;       { Pointer to a menu item structure }
  TextPtr  : pIntuiText;      { Pointer to a IntuiText structure }
begin
  quit := FALSE;                           { Not done yet }
  repeat
    dummy := Wait(BitMask(window^.UserPort^.MP_SIGBIT));
                                        { Wait for something to happen }

    Imessage := pIntuiMessage(GetMsg(window^.UserPort));
                                        { Find out what }
    while Imessage <> NIL do begin
      class   := Imessage^.class;       { Save for later use }
      code    := Imessage^.code;
      address := Imessage^.IAddress;
      ReplyMsg(pMessage(Imessage));     { Accept this message }
      case class of
        MENUPICK     : { The right mouse key was pressed }
                       if code <> MENUNULL then begin  { Pointed at menu? }
                         mNum := MenuNum(code);        { Title index }
                         iNum := ItemNum(code);        { Item index }
                         case mNum of
                           0 : case iNum of            { Info menu }
                                 0 : About;
                                 2 : quit := TRUE
                               end;
                           1 : case iNum of            { Sex menu }
                                 0 : SetSex(male);
                                 1 : SetSex(female)
                               end;
                           2 : case iNum of            { Mode menu }
                                 0 : SetMode(human);
                                 1 : SetMode(robot)
                               end
                         end;
                         if not ( (mNum = 0) and (iNum = 0) ) then begin
                           ItemPtr := pMenuItem(ItemAddress(menu, code));
                           TextPtr := pIntuiText(ItemPtr^.ItemFill);
                           Say(RetrieveStr(TextPtr^.IText))
                         end
                       end;
        GADGETUP     : if (address = @SpeakGadget) or (address = @InputGadget) then begin
                         MakeInputPascal;
                         Say(input)
                       end else
                       if address = @PropGadgets[0] then
                         SetFrequency(MakeValue(PropInfo[0].HorizPot, MINFREQ, MAXFREQ)) else
                       if address = @PropGadgets[1] then
                         SetRate     (MakeValue(PropInfo[1].HorizPot, MINRATE, MAXRATE)) else
   		       if address = @PropGadgets[2] then
                         SetPitch    (MakeValue(PropInfo[2].HorizPot, MINPITCH, MAXPITCH)) else
		       if address = @PropGadgets[3] then
                         SetVolume   (MakeValue(PropInfo[3].HorizPot, MINVOL,  MAXVOL ))
                       else writeln('Bad gadget! addr=',longint(address),' (dec.)');
        CLOSEWINDOW_ : quit := TRUE
      end;
      Imessage := pIntuiMessage(GetMsg(window^.UserPort)) { Get next }
    end;
  until quit
end;

begin
  SetUp;
  SelectLoop;
  GoodBye
end.