home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 4 / FreshFish_May-June1994.bin / bbs / amigalib / d988 / dqua.lha / DQua / Source / DQua10.PAS next >
Encoding:
Pascal/Delphi Source File  |  1994-04-05  |  19.5 KB  |  630 lines
  1. Program DQua;
  2.  
  3.    
  4. Uses Exec, Intuition, utility, gadtools, graphics, AmigaDOS, LSKExtras;
  5.  
  6. Const
  7.    
  8.    LLGad    = 1; { NULL initialised gadget   }
  9.    CCGad    = 2; { CreateContext() gadget    }
  10.    STRGad_A = 3; { `a' string gadget         }
  11.    STRGad_B = 4; { `b' string gadget         }
  12.    STRGad_C = 5; { `c' string gadget         }
  13.    Abt_Gad  = 6; { about, ?, gadget          }
  14.    BUTGad_S = 7; { Solve gadget              }
  15.    Eqn_Disp = 8; { Gadget with displays Eq'n }
  16.    
  17.    BorTop = 1; BorLeft = 2; BorRight = 3; BorBottom = 4;
  18.    DispBB_H = 5; EqBB_H = 6; BB_L = 7; BB_W = 8; StrG_W = 9; GadTxt_W = 10;
  19.    XSze = 11; TBS = 12; Abt_W = 13;
  20.    
  21.    Vers       : string = '$VER: DQua v1.0 © Lee S Kindness 23.11.93'#0;
  22.    Win_Title  : string = 'DQua v1.0'#0;
  23.    Scr_Title  : string = 'DQua, the de-quaderator. ©94 Lee Kindness'#0;
  24.    fontname   : string = 'topaz.font'#0;
  25.    gad1text   : string = '_a :'#0;
  26.    gad2text   : string = '_b :'#0;
  27.    gad3text   : string = '_c :'#0;
  28.    butgadtext : string = '_Solve'#0;
  29.    AbtGStr    : string = '_?'#0;
  30.    defnum     : string = '1'#0;
  31.    infotext   : string = ' ax² + bx + c = 0'#0;
  32.    SampStr    : string = 'b : '#0;
  33.    SampOut    : string = 'Imaginary roots at 0.000000098'#0;
  34.    visualinf  : pointer = NIL;
  35.    TheWindow  : pWindow = NIL;
  36.  
  37.          
  38. Var
  39.    Gads           : Array [LLGad..Eqn_Disp] Of pGadget;
  40.    Gadgetflags    : tNewGadget;
  41.    My_Font        : tTextAttr;
  42.    BevelTags      : Array[1..3] Of tTagItem;
  43.    Sizes          : Array[1..13] Of Integer;
  44.    
  45.  
  46.    
  47. { ===================================================================== } 
  48.  
  49.  
  50. { ===================================================================== }
  51.  
  52. Procedure ErrExit(Errortxt : string; ExitCode : integer);
  53.  
  54. Begin
  55.     ErrorExit('** DQua Error **'#0, Errortxt);
  56.     CloseLibrary(pLibrary(IntuitionBase));
  57.     If GadToolsBase <> NIL then CloseLibrary(pLibrary(GadtoolsBase));
  58.     If TheWindow <> NIL then CloseWindow(TheWindow);
  59.     If gads[LLGad] <> NIL then FreeGadgets(gads[LLGad]);
  60.     If VisualInf <> NIL then FreeVisualInfo(VisualInf);
  61.     Halt(exitcode);
  62. end;
  63.  
  64. { ===================================================================== }
  65.  
  66. Procedure open_libs; { open used libraries }
  67.  
  68.  
  69. Begin
  70.     IntuitionBase := NIL;
  71.    IntuitionBase := pIntuitionBase(OpenLibrary('intuition.library',34));
  72.    if IntuitionBase = NIL then halt(122);
  73.    If IntuitionBase^.LibNode.lib_Version < 36 Then
  74.         ErrExit('Intuition library v36 (2.0) required'#0, 122);
  75.  
  76.    GadToolsBase := NIL;
  77.    GadToolsBase  := pLibrary(Openlibrary('gadtools.library',36)); 
  78.    If GadtoolsBase = NIL Then
  79.         ErrExit('GadTools library v36 (2.0) required'#0, 122);
  80. End;
  81.   
  82. { ===================================================================== }
  83.  
  84. Procedure displayBevelboxes;  { used to display and refresh the boxes }
  85. Begin                         { output                                }
  86.      
  87.    DrawBevelBoxA(TheWindow^.RPort, Sizes[BB_L], Sizes[TBS] + 4 + Sizes[EqBB_H], Sizes[BB_W], Sizes[DispBB_H], @Beveltags);
  88. End;
  89.  
  90. { ===================================================================== }
  91.  
  92. Procedure setupbevelBoxes;  { set up boxes }
  93. Begin
  94.    Beveltags[1].ti_Tag  := GT_VisualInfo;
  95.    BevelTags[1].ti_Data := LONG(VisualInf);
  96.    BevelTags[2].ti_Tag  := GTBB_Recessed;
  97.    BevelTags[2].ti_Data := True_;
  98.    BevelTags[3].ti_Tag  := TAG_END;
  99. End;
  100.  
  101. { ===================================================================== }
  102. Procedure open_window;
  103.  
  104. Const
  105.     PubName : string = 'error';
  106.     
  107. Var 
  108.     Window_Tags : Array[0..17] Of tTagItem;
  109.    Gadget_Tags : Array[0..2] Of tTagItem;
  110.    sampTxt     : tIntuiText;
  111.     screendef   : pScreen;
  112.     LockKey     : Longint;
  113.     PS_List     : pList;
  114.     My_Node     : pPubScreenNode;
  115.    
  116. Begin
  117.    gads[LLGad]  := NIL; 
  118. { Get visual info and create context }
  119.     LockKey := LockIBase(0);
  120.     screendef := IntuitionBase^.ActiveScreen;
  121.     
  122.     PS_List := LockPubScreenList;
  123.     My_Node := pPubScreenNode(PS_List^.lh_Head);
  124.     While My_Node^.psn_Node.ln_Succ <> NIL Do Begin
  125.         If my_Node^.psn_Screen = screendef Then
  126.             PubName := retrievestr(My_Node^.psn_Node.ln_Name);
  127.         My_Node := pPubScreenNode(My_Node^.psn_Node.ln_Succ);
  128.     End;
  129.     UnLockPubScreenList;
  130.     UnlockIBase(LockKey);
  131.     
  132.     If pubname = 'error' Then Begin
  133.         screendef := lockPubScreen(NIL);
  134.        If screendef = NIL Then
  135.            ErrExit('Failed to lock public screen'#0, 0); 
  136.    End Else Begin
  137.         pubname := pubname + #0;
  138.        screendef := lockPubScreen(@PubName[1]);
  139.        If screendef = NIL Then 
  140.             ErrExit('Failed to lock public screen'#0, 0);
  141.     End;
  142.    VisualInf := GetVisualInfoA(screendef, NIL);
  143.    If visualinf = NIL Then
  144.       ErrExit('Failed to get visual info'#0, 0);
  145.    Gads[CCGad] := CreateContext(@gads[LLGad]);
  146.    If Gads[CCGad] = NIL Then
  147.       ErrExit('Failed to create context'#0, 0);
  148.       
  149. { Get some data from the screen }
  150.  
  151.     My_Font := Screendef^.Font^;
  152.     
  153.    Sizes[TBS]       := screendef^.WBorTop + (screendef^.Font^.ta_YSize + 1);
  154.    Sizes[XSze]      := Sizes[TBS] + 1;
  155.    sizes[BorTop]    := Screendef^.WBorTop;
  156.    sizes[BorLeft]   := Screendef^.WBorLeft;
  157.    sizes[BorRight]  := Screendef^.WBorRight;
  158.    sizes[BorBottom] := Screendef^.WBorBottom;
  159.     Sizes[StrG_W]    := My_Font.ta_YSize * 12;
  160.     Sizes[DispBB_H]  := (Sizes[XSze] * 3) + 8;
  161.     Sizes[EqBB_H]    := Sizes[XSze] ;
  162.     Samptxt.ITextFont := @My_Font;
  163.     Samptxt.IText := @Sampstr[1];
  164.     Sizes[GadTxt_W]  := IntuiTextLength(@Samptxt) + 10;
  165.     Samptxt.IText := @SampOut[1];
  166.     Sizes[BB_W]      := IntuiTextLength(@Samptxt) + 4;
  167.     Samptxt.IText := @AbtGStr[1];
  168.     Sizes[Abt_W]     := IntuiTextLength(@Samptxt);
  169.     Sizes[BB_L]      := Sizes[BorLeft] + Sizes[Gadtxt_W] + Sizes[StrG_W] + 4;
  170.     
  171. { Initilise gadget structures }
  172.    Gadget_Tags[0].ti_Tag  := GTST_String;
  173.    Gadget_Tags[0].ti_Data := LONG(@defnum[1]);
  174.    Gadget_Tags[1].ti_Tag  := GT_UnderScore;
  175.    Gadget_Tags[1].ti_Data := LONG('_');
  176.    Gadget_Tags[2].ti_Tag  := TAG_END;
  177.    
  178.    With GadgetFlags Do Begin
  179.       ng_TextAttr   := @My_Font;
  180.       ng_LeftEdge   := sizes[BorLeft] + Sizes[GadTxt_W];
  181.       ng_TopEdge    := Sizes[TBS] + 2;
  182.       ng_Width      := Sizes[StrG_W];
  183.       ng_Height     := Sizes[XSze];
  184.       ng_GadgetText := @gad1text[1];
  185.       ng_VisualInfo := VisualInf;
  186.       ng_GadgetID   := STRGad_A;
  187.    End;
  188.    
  189. { create gadgets }
  190.    Gads[STRGad_A] := CreateGadgetA(STRING_KIND, Gads[CCGad], @Gadgetflags, @Gadget_Tags);
  191.    With GadgetFlags Do Begin
  192.       ng_TopEdge    := ng_TopEdge + Sizes[XSze] + 2;
  193.       ng_GadgetText := @gad2text[1];
  194.       ng_GadgetID   := STRGad_B;
  195.    End;
  196.  
  197.    Gads[STRGad_B] := CreateGadgetA(STRING_KIND, Gads[STRGad_A], @Gadgetflags, @Gadget_Tags);
  198.    With GadgetFlags Do Begin
  199.       ng_TopEdge    := ng_TopEdge + Sizes[XSze] + 2;
  200.       ng_GadgetText := @gad3text[1];
  201.       ng_GadgetID   := STRGad_C;
  202.    End;
  203.  
  204.    Gads[STRGad_C] := CreateGadgetA(STRING_KIND, Gads[STRGad_B], @Gadgetflags, @Gadget_Tags);
  205.    With gadgetflags Do Begin
  206.        ng_LeftEdge   := Sizes[BorLeft] + 4;
  207.       ng_TopEdge    := ng_TopEdge + Sizes[XSze] + 2;
  208.       ng_Width      := Sizes[Abt_W];
  209.       ng_Height     := (Sizes[EqBB_H] + Sizes[DispBB_H] + Sizes[TBS] + 6 + Sizes[BorBottom]) - ng_TopEdge - 4;
  210.       ng_GadgetText := @AbtGStr[1];
  211.       ng_GadgetID   := Abt_Gad;
  212.    End;
  213.     Gadget_Tags[0].ti_Tag  := TAG_IGNORE;
  214.    Gads[Abt_Gad] := CreateGadgetA(BUTTON_KIND, Gads[STRGad_C], @Gadgetflags, @Gadget_Tags);
  215.    With gadgetflags Do Begin
  216.        ng_LeftEdge   := Sizes[BorLeft] + Sizes[Abt_W] + 8;
  217.       ng_Width      := Sizes[BB_L] - Sizes[BorLeft] - 12 - sizes[Abt_W];
  218.       ng_Height     := (Sizes[EqBB_H] + Sizes[DispBB_H] + Sizes[TBS] + 6 + Sizes[BorBottom]) - ng_TopEdge - 4;
  219.       ng_GadgetText := @butgadtext[1];
  220.       ng_GadgetID   := BUTGad_S;
  221.    End;
  222.     Gads[BUTGad_S] := CreateGadgetA(BUTTON_KIND, Gads[Abt_Gad], @Gadgetflags, @Gadget_Tags);
  223.    
  224.    With GadgetFlags Do Begin
  225.        ng_LeftEdge   := Sizes[BB_L];
  226.        ng_TopEdge    := Sizes[TBS] + 2;
  227.        ng_Width      := Sizes[BB_W];
  228.        ng_Height     := Sizes[EqBB_H];
  229.        ng_GadgetText := NIL;
  230.        ng_GadgetID   := Eqn_Disp;
  231.    End;
  232.     Gadget_Tags[0].ti_Tag  := GTTX_Text;
  233.     Gadget_Tags[0].ti_Data := LONG(@infotext[1]);
  234.    Gadget_Tags[1].ti_Tag  := GTTX_Border;
  235.     Gadget_Tags[1].ti_Data := True_;
  236.  
  237.    Gads[Eqn_Disp] := CreateGadgetA(TEXT_KIND, Gads[BUTGad_S], @Gadgetflags, @Gadget_Tags);    
  238.    
  239.    If Gads[CCGad] = NIL Then
  240.       ErrExit('Failed to create gadgets'#0, 0);
  241.    
  242. { window structure }
  243.     Window_Tags[0].ti_Tag  := WA_Left;
  244.    Window_Tags[0].ti_Data := screendef^.MouseX - ((Sizes[BB_L] + Sizes[BB_W] + Sizes[BorRight] + 6) div 2);
  245.    Window_Tags[1].ti_Tag  := WA_Top;
  246.    Window_Tags[1].ti_Data := Screendef^.MouseY - ((Sizes[EqBB_H] + Sizes[DispBB_H] + Sizes[TBS] + 6) div 2);
  247.    Window_Tags[2].ti_Tag  := WA_Width;
  248.    Window_Tags[2].ti_Data := Sizes[BB_L] + Sizes[BB_W] + Sizes[BorRight] + 6;
  249.    Window_Tags[3].ti_Tag  := WA_Height;
  250.    Window_Tags[3].ti_Data := Sizes[EqBB_H] + Sizes[DispBB_H] + Sizes[TBS] + 6 + Sizes[BorBottom];
  251.    Window_Tags[4].ti_Tag  := WA_Title;
  252.    Window_Tags[4].ti_Data := LONG(@Win_Title[1]); 
  253.    Window_Tags[5].ti_Tag  := WA_IDCMP;
  254.    Window_Tags[5].ti_Data := IDCMP_CLOSEWINDOW Or INTEGERIDCMP 
  255.         Or IDCMP_REFRESHWINDOW Or BUTTONIDCMP 
  256.         Or IDCMP_MOUSEBUTTONS Or IDCMP_VANILLAKEY;
  257.    Window_Tags[6].ti_Tag  := WA_CloseGadget;
  258.    Window_Tags[6].ti_Data := True_;
  259.    Window_Tags[7].ti_Tag  := WA_DragBar;
  260.    Window_Tags[7].ti_Data := True_;
  261.    Window_Tags[8].ti_Tag  := WA_DepthGadget;
  262.    Window_Tags[8].ti_Data := True_;
  263.    Window_Tags[9].ti_Tag  := WA_AutoAdjust;
  264.    Window_Tags[9].ti_Data := True_;
  265.    Window_Tags[10].ti_Tag := WA_Activate;
  266.    Window_Tags[10].ti_Data:= True_;
  267.    Window_Tags[11].ti_Tag := WA_Gadgets;
  268.    Window_Tags[11].ti_Data:= LONG(gads[LLGad]);
  269.    Window_Tags[12].ti_Tag := WA_SimpleRefresh;
  270.    Window_Tags[12].ti_Data:= True_;
  271.    Window_Tags[13].ti_Tag := WA_RMBTrap;
  272.    Window_Tags[13].ti_Data:= True_;
  273.    Window_Tags[14].ti_Tag := WA_PubScreenName;
  274.    Window_Tags[14].ti_Data:= LONG(@pubname[1]);
  275.    Window_Tags[15].ti_Tag := WA_PubScreenFallBack;
  276.    Window_Tags[15].ti_Data:= True_; 
  277.      Window_Tags[16].ti_Tag := WA_ScreenTitle;
  278.    Window_Tags[16].ti_Data:= LONG(@Scr_Title[1]);
  279.    Window_Tags[17].ti_Tag := TAG_DONE;
  280.    
  281.    TheWindow := OpenWindowTaglist(NIL,@Window_Tags);
  282.    If TheWindow = NIL Then 
  283.        ErrExit('Failed to create window'#0, 206);
  284.    setupbevelboxes;
  285.    displaybevelboxes;   
  286.    GT_RefreshWindow(TheWindow, NIL);
  287.    
  288.    If pubname = 'error' Then UnlockPubScreen(NIL, screendef)
  289.    Else UnlockPubScreen(@PubName[1], screendef);
  290. End;
  291.  
  292. { ===================================================================== }
  293.  
  294. Procedure Close_Libs;   { close all opened libs }
  295.  
  296. Begin
  297.    CloseLibrary(pLibrary(IntuitionBase));
  298.    CloseLibrary(pLibrary(GadtoolsBase));
  299. End;
  300.  
  301. { ===================================================================== }
  302.  
  303. Procedure Close_Window;
  304.  
  305. Begin
  306.    CloseWindow(TheWindow);       { close window and free gadgets and }
  307.    FreeGadgets(gads[LLGad]);     { visualinfo                        }
  308.    FreeVisualInfo(VisualInf);
  309. End;
  310.  
  311. { ===================================================================== }
  312.  
  313.  
  314. { ===================================================================== }
  315. Procedure HandleIDCMP;
  316.  
  317. Type
  318.     strarray = Array[1..3] Of string;
  319.     Tag2     = Array[0..1] Of tTagItem;
  320.     
  321. Const
  322.    exitflag : Boolean  = False;
  323.    small    : Boolean  = False;
  324.    NumStrs  : shortint = 3;
  325.    
  326. Var dummy     : longint;           { the main loop of the program. }
  327.    defnumTag  : tag2;              { monitors IDCMP messages and   }
  328.    message    : pIntuiMessage;     { responds as appropriate       }
  329.    MsgClass   : LongInt;
  330.    MsgCode    : Word;
  331.    gadcode    : pGadget;
  332.    out        : strarray;
  333.    clearblock : tImage;
  334.    outformat  : tIntuiText;
  335.    d, a ,b,
  336.    c, a2      : Extended; { real }
  337.    StrInfo    : pStringInfo;
  338.    tempint    : Array[1..4] Of longint;
  339.    OKRes      : boolean;
  340.     AboutReq   : array [0..9] of tIntuiText;  { Texts for "About" requester }
  341.     AboutReqOk : tIntuiText;                   { "Ok" in "About" requester }
  342.     AboutStrs  : array[0..9] of string;
  343.     i          : byte;
  344.  
  345. { ==== }
  346. Procedure CalcDundA2(Var a,b,c,a2,d : Real);      
  347.  
  348. Begin
  349.    a2 := 2*a;
  350.    d := Sqr(b) - 4*a*c;       { calculate discriminate, the core of the program } 
  351. End;
  352.  
  353. { ==== }
  354.  
  355. Procedure OneRoot(c,b : Real; Var result : strarray; Var choices : shortint);
  356.  
  357. Var
  358.    numstr : string;
  359.    
  360. Begin
  361.    str((-c/b):10:4, numstr);
  362.    result[1] := 'One root at ' + numstr + #0;
  363.    choices := 1;
  364. End;
  365.  
  366. { ==== }
  367.  
  368. Procedure EqualRoots(b,a2 : Real; Var result : strarray; Var choice : shortint);
  369.  
  370. Var
  371.    numstr : string;
  372.    
  373. Begin
  374.    str((-b/a2):10:4, numstr);
  375.    result[1] := 'Repeated (equal) roots at '#0;
  376.    result[2] := '    ' + numstr + #0;
  377.    choice := 2;
  378. End;
  379.  
  380. { ==== }
  381.  
  382. Procedure RealRoots(b,a2,d : Real; Var result : strarray; Var choice : shortint);
  383.  
  384. Var
  385.    numstr, numstr2 : string;
  386.    
  387. Begin
  388.    str(((-b+Sqrt(d))/a2):10:4, numstr);
  389.    str(((-b-sqrt(d))/a2):10:4, numstr2);
  390.    result[1] := 'Real roots at ' + numstr + #0;
  391.    result[2] := 'and           ' + numstr2 + #0;
  392.    choice := 2;
  393. End;
  394.  
  395. { ==== }
  396.  
  397. Procedure ImaginaryRoots(b,d,a2 : Real; Var result : strarray; Var choice : shortint);
  398.  
  399. Var
  400.    numstr, numstr2, numstr3 : string;
  401.    
  402. Begin
  403.    str((-b/a2):10:4, numstr);
  404.    str((Sqrt(-d)/a2):10:4, numstr2);
  405.    str((-sqrt(-d)/a2):10:4, numstr3);
  406.    result[1] := 'Imaginary roots at ' + #0;
  407.    result[2] := '    ' + numstr + numstr2 + #0;
  408.    result[3] := 'and ' + numstr + numstr3 + #0;
  409.    choice := 3;
  410. End;
  411.  
  412. { ==== }
  413.  
  414. Procedure printtext(Var strings : strarray; choice : shortint);
  415.  
  416. Var
  417.     Temp, n : shortint;
  418.    y       : Integer;
  419.    
  420. Begin
  421.    DrawImage(TheWindow^.RPort, @clearblock, 0, 0);
  422.    For n := 1 To choice Do Begin
  423.       y := (Sizes[XSze] * (n-1) + (n * 2));
  424.       outformat.Itext := @strings[n,1];
  425.       PrintIText(TheWindow^.RPort, @outformat, 4, y);  
  426.    End;
  427. End;  
  428.  
  429. { ==== }
  430.  
  431. Procedure CheckNum(Var num : Real; Var gadg : pGadget; 
  432.                tags : tag2; strpointer : pointer);
  433.                
  434. Var
  435.    tempstr : string;
  436.    temp    : Real;
  437.    errornum: Integer;
  438.    
  439. Begin
  440.    tempstr := RetrieveStr(StrPointer);
  441.    Val(tempstr, temp, errornum);
  442.    If errornum <> 0 Then Begin
  443.       GT_SetGadgetAttrsA(gadg, TheWindow, NIL, @tags);
  444.       num := 1;
  445.       DisplayBeep(NIL);
  446.    End Else 
  447.       num := temp;
  448. End;
  449.  
  450. Procedure CalcLoop;
  451. begin
  452.     StrInfo := Gads[CCGad]^.NextGadget^.SpecialInfo;
  453.     CheckNum(a, Gads[STRGad_A], defnumtag, strinfo^.buffer);
  454.     StrInfo := Gads[CCGad]^.NextGadget^.NextGadget^.SpecialInfo;
  455.     CheckNum(b, Gads[STRGad_B], defnumtag, strinfo^.buffer);
  456.     StrInfo := Gads[CCGad]^.NextGadget^.NextGadget^.NextGadget^.SpecialInfo;
  457.     CheckNum(c, Gads[STRGad_C], defnumtag, strinfo^.buffer);
  458.     CalcDundA2(a,b,c,a2,d);
  459.     If a = 0 Then Begin
  460.         oneroot(c,b,out, NumStrs);
  461.         Printtext(out,NumStrs); 
  462.     End Else Begin
  463.         If d = 0 Then Begin
  464.             equalroots(b,a2,out,NumStrs);
  465.             Printtext(out,NumStrs); 
  466.         End Else Begin
  467.             If d > 0 Then Begin
  468.                 realroots(b,a2,d,out,numstrs);
  469.                 Printtext(out,NumStrs);
  470.             End Else Begin 
  471.                 imaginaryroots(b,d,a2,out,numstrs);
  472.                 Printtext(out,NumStrs);
  473.             End; {else}
  474.         End; {else}
  475.     End; {else}
  476. End; 
  477.  
  478.  
  479. Begin
  480.     AboutStrs[0] := 'DQua version 1.0 (2.1.94)'#0;
  481.     AboutStrs[1] := 'Written by Lee Kindness '#0;
  482.     AboutStrs[2] := 'using Highspeed Pascal.'#0;
  483.     AboutStrs[3] := ''#0;
  484.     AboutStrs[4] := 'Comments to :'#0;
  485.     AboutStrs[5] := '8 Craigmarn Rd.'#0;
  486.     AboutStrs[6] := 'Portlethen Village'#0;
  487.     AboutStrs[7] := 'ABERDEEN AB1 4QR'#0;
  488.     AboutStrs[8] := 'SCOTLAND'#0;
  489.     AboutStrs[9] := 'Resume'#0;
  490.     
  491.     for i := 0 to 9 do
  492.     with AboutReq[i] do begin
  493.       FrontPen  := 0;
  494.       BackPen   := 1;
  495.       DrawMode  := JAM1;
  496.       LeftEdge  := 0;
  497.       TopEdge   := (Sizes[XSze] * i) + 0;
  498.       ITextFont := @My_Font;
  499.       IText     := @AboutStrs[i,1];
  500.       if i < 8 then NextText  := @AboutReq[i+1] else NextText := NIL
  501.     end;
  502.     with AboutReqOk do begin
  503.     FrontPen  := 0;
  504.     BackPen   := 1;
  505.     DrawMode  := JAM1;
  506.     LeftEdge  := 0;                     { Position relative to gadget }
  507.     TopEdge   := 0;
  508.     ITextFont := @My_Font;
  509.     IText     := @AboutStrs[9,1];
  510.     NextText  := NIL
  511.   end;
  512.   
  513.    With outformat Do Begin
  514.       FrontPen := 1;
  515.       DrawMode := JAM1;
  516.       LeftEdge := Sizes[BB_L];
  517.       TopEdge  := Sizes[TBS] + 4 + Sizes[EqBB_H];
  518.       ITextFont:= @My_Font;
  519.       IText    := NIL;
  520.       NextText := NIL;
  521.    End;
  522.    With clearblock Do Begin
  523.       LeftEdge   := Sizes[BB_L] + Sizes[BorLeft];
  524.       TopEdge    := Sizes[TBS] + 4 + Sizes[EqBB_H] + Sizes[BorTop];
  525.       Width      := Sizes[BB_W] - Sizes[BorLeft] - Sizes[BorRight];
  526.       Height     := Sizes[DispBB_H] - Sizes[BorBottom] - Sizes[BorTop];
  527.       Depth      := 0;
  528.       ImageData  := NIL;
  529.       PlanePick  := 0;
  530.       PlaneOnOff := 0;
  531.       NextImage  := NIL;
  532.    End;
  533.    out[1] := '                              '#0;
  534.    out[2] := '                              '#0;
  535.    out[3] := '                              '#0;
  536.    defnumtag[0].ti_Tag  := GTST_String;
  537.    defnumtag[0].ti_Data := LONG(@defnum[1]);
  538.    defnumtag[1].ti_Tag  := TAG_END;
  539.    tempint[4] := TheWindow^.Height;
  540.    While Not exitflag Do Begin
  541.       dummy    := Wait(BitMask(TheWindow^.UserPort^.MP_SIGBIT));
  542.       Repeat
  543.           message  := GT_GetIMsg(TheWindow^.userPort);
  544.           MsgClass := message^.Class;
  545.           MsgCode  := message^.Code;
  546.           GadCode  := pGadget(message^.IAddress);
  547.           StrInfo  := gadcode^.SpecialInfo;
  548.              GT_ReplyIMsg(message);
  549.           Case MsgClass Of
  550.           
  551.              IDCMP_REFRESHWINDOW : Begin
  552.                 GT_BeginRefresh(TheWindow);
  553.                 Printtext(out,NumStrs);
  554.                 displaybevelboxes;
  555.                 GT_EndRefresh(TheWindow, True);
  556.              End;
  557.              
  558.              IDCMP_MOUSEBUTTONS : Begin
  559.                   Case MsgCode Of
  560.                       MENUUP : Begin
  561.                           tempint[1] := TheWindow^.LeftEdge;
  562.                               tempint[2] := TheWindow^.TopEdge;
  563.                               tempint[3] := TheWindow^.Width;
  564.                               If Small Then Begin
  565.                               ChangeWindowBox(TheWindow, tempint[1], tempint[2], tempint[3], Tempint[4]);
  566.                               Small := False;
  567.                           End Else Begin
  568.                               ChangeWindowBox(TheWindow, tempint[1], tempint[2], tempint[3], Sizes[TBS]);
  569.                               Small := True;
  570.                           End;
  571.                       End;
  572.                   End;
  573.               End;
  574.               
  575.              IDCMP_CLOSEWINDOW : exitflag := True;
  576.              
  577.              IDCMP_GADGETUP : Begin
  578.                 Case gadcode^.GadgetID Of
  579.                    STRGad_A : Begin
  580.                       CheckNum(a, Gads[STRGad_A], defnumtag, strinfo^.buffer);
  581.                       OKRes := ActivateGadget(Gads[STRGad_B], TheWindow, NIL);
  582.                    End;
  583.                    STRGad_B : Begin
  584.                       CheckNum(b, Gads[STRGad_B], defnumtag, strinfo^.buffer);
  585.                       OKRes := ActivateGadget(Gads[STRGad_C], TheWindow, NIL);
  586.                    End;
  587.                    STRGad_C : Begin
  588.                       CheckNum(c, Gads[STRGad_C], defnumtag, strinfo^.buffer);
  589.                       OKRes := ActivateGadget(Gads[STRGad_A], TheWindow, NIL);
  590.                    End;
  591.                    BUTGad_S : CalcLoop;
  592.                    Abt_Gad  : OKRes := AutoRequest(TheWindow, @AboutReq[0], NIL, @AboutReqOk, 0, 0, 320, 155);
  593.                 End; {case}
  594.             end;
  595.             
  596.             IDCMP_VANILLAKEY : begin
  597.                 case chr(msgcode) of
  598.                     'S','s' : CalcLoop;
  599.                     'A','a' : OKRes := ActivateGadget(Gads[STRGad_A], TheWindow, NIL);
  600.                     'B','b' : OKRes := ActivateGadget(Gads[STRGad_B], TheWindow, NIL);
  601.                     'C','c' : OKRes := ActivateGadget(Gads[STRGad_C], TheWindow, NIL);
  602.                     '/','?' : OKRes := AutoRequest(TheWindow, @AboutReq[0], NIL, @AboutReqOk, 0, 0, 0, 0);
  603.             end;
  604.             end; 
  605.          End; {case}
  606.  
  607.       Until message = NIL;
  608.    End; {while}
  609. End;
  610. { ==== Main Procedure ================================================= }
  611.  
  612. Procedure main;
  613.  
  614. Begin
  615.    Open_Libs;
  616.    Open_Window;
  617.    HandleIDCMP;
  618.    close_Window;
  619.    Close_Libs;
  620. End;
  621.  
  622. { =================================================================== }
  623.  
  624. Begin
  625. main
  626. End.
  627.  
  628.       
  629.       
  630.