home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 4 / FreshFish_May-June1994.bin / new / amigalibdisks / d988 / dqua / source / dqua10.pas next >
Pascal/Delphi Source File  |  1994-04-04  |  20KB  |  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.