home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / applications / misc / maccash.lha / MacCash / Src / MacCash.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-01-13  |  24.1 KB  |  869 lines
  1. Program MacCash;
  2. {$F-,I-,R-,S+,V-,M 5,1,1,1}
  3.  
  4. Uses
  5.     Exec, Intuition, Graphics, AmigaPrinter, GadTools, CStrConstPtr, Amiga,
  6.     Utility, DiskFont, AmigaDos, Icon, Workbench, 
  7.     GenerateLotteryNums, EnableDisableWindow;
  8.     
  9. Const
  10.     G_CC  =  0; { Gadget ids }
  11.     G_BLV =  1;
  12.     G_N1  =  2;
  13.     G_N2  =  3;
  14.     G_N3  =  4;
  15.     G_N4  =  5;
  16.     G_N5  =  6;
  17.     G_N6  =  7;
  18.     G_NW  =  8;
  19.     G_RB  =  9;
  20.     G_RA  = 10;
  21.     G_CB  = 11;
  22.     G_CA  = 12;
  23.     G_ST  = 13;
  24.     G_NI  = 14;
  25.     
  26.     { menu ids }
  27.     M_PN   = 1;
  28.     M_INFO = 2;
  29.     M_QUIT = 3;
  30.     
  31.     BM_WID =  123;
  32.     BM_LEN =  195;
  33.     PR_WID = 3250;
  34.     PR_LEN = 4937;
  35.     
  36.     ves : String[27] = '$VER: MacCash 1.1 13.01.95'#0;
  37.     
  38.     BoardNamesA : Array[1..NUM_BOARDS] of String[7] = ('Board A',
  39.                                                        'Board B',
  40.                                                        'Board C',
  41.                                                        'Board D',
  42.                                                        'Board E');
  43.     
  44. Type
  45.     tProgVars = Record
  46.         arg_ps : String;
  47.     End;
  48.     GadA = Array[G_CC..G_NI] of pGadget;
  49.     tNumInfo = Record
  50.         ni_Mean,
  51.         ni_Median,
  52.         ni_Variance,
  53.         ni_SD,
  54.         ni_Range,
  55.         ni_IQR : String[20];
  56.     End;
  57.     
  58. {$I ToolType.PAS}
  59.     
  60. Var
  61.     font     : tTextAttr;
  62.     txtfont  : pTextFont;
  63.     lvlabs   : Array[0..NUM_BOARDS] of STRPTR;
  64.     weeklabs : Array[0..8] of STRPTR;
  65.     lvlist   : pList;
  66.     
  67. (*****************************************************************************
  68.  * A little routine to fill in the members of a NewMenu struct
  69.  *
  70.  * Cheat & use a bit of assembler to get direct access to the embedded
  71.  * string constants
  72.  *)
  73. procedure nm(var mnm: tNewMenu;
  74.     nmType: byte;
  75.     nmLabel: string;
  76.     nmCommKey: string;
  77.     nmFlags: word;
  78.     nmMutualExclude: longint;
  79.     nmUserData: LONG); assembler;
  80. asm
  81.     move.l    mnm,a0                                    { address of the element }
  82.     move.b    nmType,tNewMenu.nm_Type(a0)                        { copy the type }
  83.  
  84.     move.l    nmLabel,a1                      { the address of the Pascal string }
  85.     tst.b    (a1)+                     { check for zero length & skip length byte }
  86.     bne        @1                                      { if not zero, nothing to do }
  87.     move.l    #NM_BARLABEL,a1              { substitute empty strings with a bar }
  88. @1:    move.l    a1,tNewMenu.nm_Label(a0)                    { store the C string }
  89.  
  90.     move.l    nmCommKey,a1                                { same for the CommKey }
  91.     tst.b    (a1)+
  92.     bne        @2
  93.     suba.l    a1,a1                                { use nil if the empty string }
  94. @2:    move.l    a1,tNewMenu.nm_CommKey(a0)
  95.                                                       { the remaining fields }
  96.     move.w    nmFlags,tNewMenu.nm_Flags(a0)
  97.     move.l    nmMutualExclude,tNewMenu.nm_MutualExclude(a0)
  98.     move.l    nmUserData,tNewMenu.nm_UserData(a0)
  99. end;
  100.  
  101. (****************************************************************************)
  102. Function OpenMainWindow(VAR Args : tProgVars; 
  103.                         VAR vi   : Pointer;
  104.                         VAR G    : GadA;
  105.                         VAR rk   : pRemember;
  106.                         VAR b    : tBoards;
  107.                         VAR ms   : pMenu) : pWindow;
  108.  
  109. CONST
  110.     XSPACE =  8; { Horizontal space between gadgets }
  111.     YSPACE =  4; { Vertical spacing between gadgets }
  112.     S_TBS  =  0;
  113.     S_CW   =  1;
  114.     S_LB   =  2;
  115.     S_GH   =  3;
  116.     
  117. VAR
  118.     t      : Array[0..20] of LONG;     { tags                         }
  119.     m      : Array[0..10] of tNewMenu; { for init. of menu            }
  120.     screen : pScreen;                  { the screen we are opening on }
  121.     w      : pWindow;                  { the window we are creating   }
  122.     ng     : tNewGadget;               { to setup gadgets             }
  123.     S      : Array[0..3] of LONG;      { various sizes                }
  124.     n      : Integer;
  125.     nd     : pNode;
  126.     ts     : String;
  127.     mm     : Array[0..5] of tNewMenu;
  128.     ok     : Boolean;
  129.     
  130. Begin
  131.     w := NIL;
  132.     
  133.     { init menus }
  134.     nm(mm[0], NM_TITLE, 'Project'#0, '', 0, 0, 0);
  135.     nm(mm[1], NM_ITEM , 'Print Numbers'#0, 'N'#0, 0, 0, M_PN);
  136.     nm(mm[2], NM_ITEM , 'About...'#0, '?'#0, 0, 0, M_INFO);
  137.     nm(mm[3], NM_ITEM , '', '', 0, 0, 0);
  138.     nm(mm[4], NM_ITEM , 'Quit'#0, 'Q'#0, 0, 0, M_QUIT);
  139.     nm(mm[5], NM_END , '', '', 0, 0, 0);
  140.  
  141.     { Lock the screen }
  142.     If Args.arg_ps = '' then
  143.         screen := LockPubScreen(NIL)
  144.     else begin
  145.         Args.arg_ps := Args.arg_ps + #0;
  146.         screen := LockPubScreen(@Args.arg_ps[1]);
  147.         If Screen = NIL then
  148.             screen := LockPubScreen(NIL);
  149.     End;
  150.     If screen <> NIL then begin
  151.         { Get visual info }
  152.         vi := GetVisualInfoA(screen, NIL);
  153.         If vi <> NIL Then begin
  154.             { create context }
  155.             G[G_NI] := NIL;
  156.             G[G_CC] := CreateContext(@G[G_NI]);
  157.             If G[G_CC] <> NIL Then begin
  158.                 
  159.                 forbid;
  160.                 { convert textfont to a textattr }
  161.                 With font, GfxBase^.DefaultFont^ do begin
  162.                     ta_Name  := CSCPAR(@rk, PtrToPas(tf_Message.mn_Node.ln_Name));
  163.                     ta_YSize := tf_YSize;
  164.                     ta_Style := tf_Style;
  165.                     ta_Flags := tf_Flags;
  166.                 End;
  167.                 permit;
  168.                 txtfont := OpenDiskFont(@font);
  169.                 
  170.                 { Get some size info }
  171.                 { size of top border }
  172.                 S[S_TBS] := screen^.WBorTop + screen^.Font^.ta_YSize + 1;
  173.                 { pixel width of a character, were using the default monospace font }
  174.                 { it is far to much hastle to ude the screen font }
  175.                 S[S_CW] := TxtFont^.tf_XSize;
  176.                 { primary gadget height }
  177.                 S[S_GH] := TxtFont^.tf_YSize + 4;
  178.                 { left border size }
  179.                 S[S_LB] := screen^.WBorLeft;
  180.  
  181.                 { Make the gadgets }
  182.                 With ng do begin
  183.                     ng_LeftEdge   := S[S_LB] + XSPACE;
  184.                     ng_TopEdge    := S[S_TBS] + YSPACE;
  185.                     ng_Width      := S[S_CW] * 7 * NUM_NUMS;
  186.                     ng_Height     := ((S[S_GH] - 4) * (NUM_BOARDS+1)) + 4;
  187.                     ng_GadgetText := NIL{CSCPAR(@rk, 'Boards')};
  188.                     ng_TextAttr   := @font;
  189.                     ng_GadgetID   := G_BLV;
  190.                     ng_Flags      := 0;
  191.                     ng_VisualInfo := vi;
  192.                     ng_UserData   := NIL;
  193.                 End;
  194.                 ts := '    0   0   0   0   0   0';
  195.                 lvlabs[0] := CSCPAR(@rk, BoardNamesA[1] + ts);
  196.                 lvlabs[1] := CSCPAR(@rk, BoardNamesA[2] + ts);
  197.                 lvlabs[2] := CSCPAR(@rk, BoardNamesA[3] + ts);
  198.                 lvlabs[3] := CSCPAR(@rk, BoardNamesA[4] + ts);
  199.                 lvlabs[4] := CSCPAR(@rk, BoardNamesA[5] + ts);
  200.                 lvlist := AllocRemember(@rk, Sizeof(tList), MEMF_CLEAR);
  201.                 if lvlist = NIL then Halt;
  202.                 NewList(lvlist);
  203.                 For n := 0 to 4 do begin
  204.                     nd := AllocRemember(@rk, Sizeof(tNode), MEMF_CLEAR);
  205.                     if nd <> NIL then begin
  206.                         nd^.ln_Name := lvlabs[n];
  207.                         AddTail(lvlist, nd);
  208.                     End;
  209.                 End;
  210.                 t[0] := GTLV_Labels;
  211.                 t[1] := LONG(lvlist);
  212.                 t[2] := GTLV_ShowSelected;
  213.                 t[3] := 0;
  214.                 t[4] := GTLV_Selected;
  215.                 t[5] := 0;
  216.                 t[6] := TAG_END;
  217.                 G[ng.ng_GadgetID] := CreateGadgetA(LISTVIEW_KIND, G[ng.ng_GadgetID-1], @ng, @t); 
  218.                 
  219.                 With ng do begin    
  220.                     ng_TopEdge := ng_TopEdge + ng_Height + YSPACE;
  221.                     If GadToolsBase^.lib_Version < 39 then
  222.                         ng_TopEdge := ng_TopEdge + S[S_GH];
  223.                     ng_Width := S[S_CW] * 7;
  224.                     ng_Height := S[S_GH];
  225.                     ng_GadgetText := NIL; 
  226.                 End;
  227.                 t[0] := GTIN_MaxChars;
  228.                 t[1] := 2;
  229.                 t[2] := STRINGA_Justification;
  230.                 t[3] := GACT_STRINGCENTER;
  231.                 t[4] := STRINGA_ReplaceMode;
  232.                 t[5] := False_;
  233.                 t[6] := TAG_END;
  234.                 For n := G_N1 to G_N6 do begin
  235.                     ng.ng_GadgetID := n;
  236.                     ng.ng_UserData := Pointer(n - G_N1 + 1);
  237.                     G[ng.ng_GadgetID] := CreateGadgetA(INTEGER_KIND, G[ng.ng_GadgetID-1], @ng, @t);
  238.                     With ng do
  239.                         ng_LeftEdge := ng_LeftEdge + ng_Width;
  240.                 End;
  241.                 
  242.                 weeklabs[0] := CSCPAR(@rk, '1');
  243.                 weeklabs[1] := CSCPAR(@rk, '2');
  244.                 weeklabs[2] := CSCPAR(@rk, '3');
  245.                 weeklabs[3] := CSCPAR(@rk, '4');
  246.                 weeklabs[4] := CSCPAR(@rk, '5');
  247.                 weeklabs[5] := CSCPAR(@rk, '6');
  248.                 weeklabs[6] := CSCPAR(@rk, '7');
  249.                 weeklabs[7] := CSCPAR(@rk, '8');
  250.                 weeklabs[8] := NIL;
  251.                 t[0] := GTCY_Labels;
  252.                 t[1] := LONG(@weeklabs);
  253.                 t[2] := TAG_END;
  254.                 With ng do begin
  255.                     ng_TopEdge    := ng_TopEdge + S[S_GH] + YSPACE;
  256.                     ng_LeftEdge   := S[S_LB] + XSPACE + (17 * S[S_CW]);
  257.                     ng_Width      := (S[S_CW] * 7 * NUM_NUMS) - (17 * S[S_CW]);
  258.                     ng_GadgetText := CSCPAR(@rk, 'Number of Draws');
  259.                     ng_Flags      := PLACETEXT_LEFT;
  260.                     ng_GadgetID   := G_NW;
  261.                 End;
  262.                 G[ng.ng_GadgetID] := CreateGadgetA(CYCLE_KIND, G[ng.ng_GadgetID-1], @ng, @t);
  263.                 
  264.                 With ng do begin
  265.                     ng_TopEdge    := S[S_TBS] + YSPACE;
  266.                     ng_Height     := (G[ng_GadgetID]^.TopEdge + G[ng_GadgetID]^.Height - 
  267.                                      ng_TopEdge - (4 * YSPACE)) div 5;
  268.                     ng_LeftEdge   := ng_LeftEdge + ng_Width + XSPACE;
  269.                     ng_Width      := S[S_CW] * 25;
  270.                     ng_GadgetText := CSCPAR(@rk, 'Random Current Board');
  271.                     ng_Flags      := 0;
  272.                     ng_GadgetID   := G_RB;
  273.                 End;
  274.                 G[ng.ng_GadgetID] := CreateGadgetA(BUTTON_KIND, G[ng.ng_GadgetID-1], @ng, NIL);
  275.                 
  276.                 With ng do begin
  277.                     ng_TopEdge    := ng_TopEdge + ng_Height + YSPACE;
  278.                     ng_GadgetText := CSCPAR(@rk, 'Random All Boards');
  279.                     ng_GadgetID   := G_RA;
  280.                 End;
  281.                 G[ng.ng_GadgetID] := CreateGadgetA(BUTTON_KIND, G[ng.ng_GadgetID-1], @ng, NIL);
  282.                 
  283.                 With ng do begin
  284.                     ng_TopEdge    := ng_TopEdge + ng_Height + YSPACE;
  285.                     ng_GadgetText := CSCPAR(@rk, 'Clear Current Board');
  286.                     ng_GadgetID   := G_CB;
  287.                 End;
  288.                 G[ng.ng_GadgetID] := CreateGadgetA(BUTTON_KIND, G[ng.ng_GadgetID-1], @ng, NIL);
  289.  
  290.                 With ng do begin
  291.                     ng_TopEdge    := ng_TopEdge + ng_Height + YSPACE;
  292.                     ng_GadgetText := CSCPAR(@rk, 'Clear All Boards');
  293.                     ng_GadgetID   := G_CA;
  294.                 End;
  295.                 G[ng.ng_GadgetID] := CreateGadgetA(BUTTON_KIND, G[ng.ng_GadgetID-1], @ng, NIL);
  296.                 
  297.                 With ng do begin
  298.                     ng_TopEdge    := ng_TopEdge + ng_Height + YSPACE;
  299.                     ng_GadgetText := CSCPAR(@rk, 'Statistics for Board');
  300.                     ng_GadgetID   := G_ST;
  301.                 End;
  302.                 G[ng.ng_GadgetID] := CreateGadgetA(BUTTON_KIND, G[ng.ng_GadgetID-1], @ng, NIL);
  303.  
  304.                 If G[G_NI] <> NIL then begin
  305.                     t[ 0] := WA_Left;
  306.                     t[ 1] := 40;
  307.                     t[ 2] := WA_Top;
  308.                     t[ 3] := 20;
  309.                     t[ 4] := WA_InnerWidth;
  310.                     t[ 5] := ng.ng_LeftEdge + ng.ng_Width + XSPACE - S[S_LB];
  311.                     t[ 6] := WA_InnerHeight;
  312.                     t[ 7] := G[G_NW]^.TopEdge + G[G_NW]^.Height + YSPACE - S[S_TBS];
  313.                     t[ 8] := WA_Flags;
  314.                     t[ 9] := WFLG_CLOSEGADGET|WFLG_DRAGBAR|WFLG_DEPTHGADGET|WFLG_ACTIVATE
  315.                              |WFLG_SIMPLE_REFRESH|WFLG_NEWLOOKMENUS;
  316.                     t[10] := WA_Gadgets;
  317.                     t[11] := LONG(G[G_NI]);
  318.                     t[12] := WA_PubScreen;
  319.                     t[13] := LONG(screen);
  320.                     t[14] := WA_IDCMP;
  321.                     t[15] := LISTVIEWIDCMP|INTEGERIDCMP|IDCMP_CLOSEWINDOW|
  322.                              IDCMP_MENUPICK|IDCMP_REFRESHWINDOW;
  323.                     t[16] := WA_Title;
  324.                     t[17] := LONG(CSCPAR(@rk, 'MacCash -- Generate and Print UK Lottery Numbers'));
  325.                     t[18] := WA_ScreenTitle;
  326.                     t[19] := LONG(CSCPAR(@rk, 'MacCash ©Lee Kindness'));
  327.                     t[20] := TAG_END;
  328.                     w := OpenWindowTagList(NIL, @t);
  329.                     If w <> NIL then begin
  330.                         ms := CreateMenusA(@mm, NIL);
  331.                         if ms <> NIL then begin
  332.                             t[0] := GTMN_NewLookMenus;
  333.                             t[1] := True_;
  334.                             t[2] := TAG_END;
  335.                             if LayoutMenusA(ms,vi,@t) then
  336.                                 OK := SetMenuStrip(w,ms);
  337.                         End;
  338.                         GT_RefreshWindow(w, NIL);
  339.                     End;
  340.                 End;
  341.             End;
  342.         End;
  343.         UnLockPubScreen(NIL, Screen);
  344.     End;
  345.     { Return result }
  346.     OpenMainWindow := w;
  347. End {OpenMainWindow};
  348.  
  349. (****************************************************************************)
  350. Procedure CloseMainWindow(VAR w  : pWindow; 
  351.                           VAR vi : Pointer;
  352.                           VAR G  : GadA;
  353.                           VAR ms : pMenu);
  354.  
  355. Begin
  356.     if ms <> NIL then begin
  357.         ClearMenuStrip(w);
  358.         FreeMenus(ms);
  359.         ms := NIL;
  360.     end;
  361.     CloseWindow(w);
  362.     w := NIL;
  363.     FreeGadgets(G[G_NI]);
  364.     FreeVisualInfo(vi);
  365.     vi := NIL;
  366.     CloseFont(txtFont);
  367. End;
  368.  
  369. (****************************************************************************)
  370. Procedure AttachObjectList(VAR g    : pGadget;
  371.                            VAR w    : pWindow;
  372.                            VAR list : pList);
  373.  
  374. VAR 
  375.     t : array[0..2] of LONG;
  376.  
  377. begin
  378.     t[0] := GTLV_Labels;
  379.     t[1] := LONG(List);
  380.     t[2] := TAG_END;
  381.     GT_SetGadgetAttrsA(g, w, NIL, @t);
  382. end;
  383.  
  384. (****************************************************************************)
  385. Procedure DetachObjectList(VAR g    : pGadget;
  386.                            VAR w    : pWindow;
  387.                            VAR list : pList);
  388.  
  389. VAR 
  390.     t : array[0..2] of LONG;
  391.  
  392. begin
  393.     t[0] := GTLV_Labels;
  394.     t[0] := -1;
  395.     t[1] := TAG_END;
  396.     GT_SetGadgetAttrsA(g, w, NIL, @t);
  397. end;
  398.  
  399.  
  400. (****************************************************************************)
  401. Procedure GetInfo(VAR b : tBoard;
  402.                   VAR i : tNumInfo);
  403. Var
  404.     sumx, sumx2,
  405.     Mean, Median,
  406.     Variance, SD,
  407.     Range, IQR : Real;
  408.     n          : Integer;
  409.                       
  410. Begin
  411.     sumx := 0;
  412.     sumx2 := 0;
  413.     For n := 1 to NUM_NUMS do begin
  414.         sumx := sumx + b[n];
  415.         sumx2 := sumx2 + sqr(b[n]);
  416.     End;
  417.     
  418.     Mean := sumx / NUM_NUMS;
  419.     Median := (b[3] + b[4]) / 2;
  420.     Variance := (sumx2 - (sqr(sumx) / NUM_NUMS)) / (NUM_NUMS - 1);
  421.     SD := sqrt(Variance);
  422.     Range := b[6] - b[1];
  423.     IQR := (b[5] + ((b[6] - b[5]) * 0.75)) - (b[1] + ((b[2] - b[1]) * 0.75));
  424.     
  425.     Str(Mean:0:3, i.ni_Mean);
  426.     Str(Median:0:3, i.ni_Median);
  427.     Str(Variance:0:3, i.ni_Variance);
  428.     Str(SD:0:3, i.ni_SD);
  429.     Str(Range:0:3, i.ni_Range);
  430.     Str(IQR:0:3, i.ni_IQR);
  431.     
  432.     i.ni_Mean := i.ni_Mean + #0;
  433.     i.ni_Median := i.ni_Median + #0;
  434.     i.ni_Variance := i.ni_Variance + #0;
  435.     i.ni_SD := i.ni_SD + #0;
  436.     i.ni_Range := i.ni_Range + #0;
  437.     i.ni_IQR := i.ni_IQR + #0;
  438. End;
  439.  
  440. (****************************************************************************)
  441. Procedure FormatNodeName(    node   : pNode;
  442.                          VAR b      : tBoard;
  443.                              ord    : Integer;
  444.                          VAR rk     : pRemember);
  445.                          
  446. Var
  447.     ts, 
  448.     ts2 : String;
  449.     n   : Integer;
  450.     
  451. Begin
  452.     ts := BoardNamesA[ord] + ' ';
  453.     For n := 1 to NUM_NUMS do begin
  454.         Str(b[n]:2, ts2);
  455.         ts := ts + '  ' + ts2;
  456.     End;
  457.     node^.ln_Name := CSCPAR(@rk, ts);
  458. End;
  459.  
  460. (****************************************************************************)
  461. Procedure ShowInfo(VAR b   : tBoards;
  462.                        ord : Integer;
  463.                    VAR w   : pWindow;
  464.                    VAR rk  : pRemember);
  465.                    
  466. Var
  467.     y  : LONG;
  468.     ez : pEasyStruct;
  469.     i  : tNumInfo;
  470.     n  : tNode;
  471.     al : Array[1..7] Of STRPTR;
  472.                    
  473. Begin
  474.     ez := AllocVec(Sizeof(tEasyStruct), MEMF_CLEAR);
  475.     if ez <> NIL then begin
  476.         GetInfo(b.bo_Nums[ord], i);
  477.         FormatNodeName(@n, b.bo_Nums[ord], ord, rk);
  478.         With ez^ do begin
  479.             es_StructSize := Sizeof(tEasyStruct);
  480.             es_Title := CSCPAR(@rk, 'Board Statistics');
  481.             es_TextFormat := CSCPAR(@rk, 
  482.                '%s'#10#10+
  483.                'Mean : %s'#10+
  484.                'Median : %s'#10+
  485.                'Variance : %s'#10+
  486.                'Standard deviation : %s'#10+
  487.                'Range : %s'#10+
  488.                'Interquartile Range : %s'#10);
  489.             es_GadgetFormat := CSCPAR(@rk, 'Ok');
  490.         End;
  491.         al[1] := n.ln_Name;
  492.         al[2] := @i.ni_Mean[1];
  493.         al[3] := @i.ni_Median[1];
  494.         al[4] := @i.ni_Variance[1];
  495.         al[5] := @i.ni_SD[1];
  496.         al[6] := @i.ni_Range[1];
  497.         al[7] := @i.ni_IQR[1];
  498.         y := EasyRequestArgs(w, ez, NIL, @al);
  499.         FreeVec(ez);
  500.     End;
  501. End;
  502.         
  503.  
  504. (****************************************************************************)
  505. Procedure Handle_RandomBoard(VAR g      : pGadget;
  506.                              VAR w      : pWindow;
  507.                              VAR list   : pList;
  508.                              VAR ord    : LONG;
  509.                              VAR b      : tBoard;
  510.                              VAR rk     : pRemember);
  511.  
  512. Var
  513.     node : pNode;
  514.     n    : Integer;
  515.     
  516. begin
  517.     DetachObjectList(g, w, list);
  518.     node := list^.lh_Head;
  519.     For n := 2 to ord do 
  520.         node := node^.ln_Succ;
  521.     RandomBoard(b);
  522.     FormatNodeName(node, b, ord, rk);
  523.     AttachObjectList(g, w, list);
  524. End;
  525.  
  526. (****************************************************************************)
  527. Procedure Handle_ClearBoard(VAR g      : pGadget;
  528.                             VAR w      : pWindow;
  529.                             VAR list   : pList;
  530.                             VAR ord    : LONG;
  531.                             VAR b  : tBoard;
  532.                             VAR rk : pRemember);
  533.  
  534. Var
  535.     node : pNode;
  536.     n    : Integer;
  537.     
  538. begin
  539.     DetachObjectList(g, w, list);
  540.     node := list^.lh_Head;
  541.     For n := 2 to ord do 
  542.         node := node^.ln_Succ;
  543.     ClearBoard(b);
  544.     FormatNodeName(node, b, ord, rk);
  545.     AttachObjectList(g, w, list);
  546. End;
  547.  
  548. (****************************************************************************)
  549. Procedure Handle_InfoMenu(VAR w  : pWindow;
  550.                           VAR rk : pRemember);
  551.  
  552. Var
  553.     ez : pEasyStruct;
  554.     y  : LONG;
  555.     al : Array[0..0] of LONG;
  556.     
  557. Begin
  558.     ez := AllocRemember(@rk, Sizeof(tEasyStruct), MEMF_CLEAR);
  559.     if ez <> NIL then begin
  560.         With ez^ do begin
  561.             es_StructSize :=  Sizeof(tEasyStruct);
  562.             es_Title := CSCPAR(@rk, 'MacCash Information');
  563.             es_TextFormat := CSCPAR(@rk,
  564.              'MacCash Copyright ©Lee Kindness.'#10+
  565.              '%s'#10+
  566.              ''#10+
  567.              'Run out of birthdays? Use MacCash to Generate your numbers...'#10+
  568.              'Read "MacCash.doc" for more information'#10+
  569.              ''#10+
  570.              'Comments to:'#10+
  571.              ' Lee Kindness'#10+
  572.              ' 8 Craigmarn Road'#10+
  573.              ' Portlethen Village'#10+
  574.              ' Aberdeen AB1 4QR'#10+
  575.              ' SCOTLAND'#10);
  576.             es_GadgetFormat := CSCPAR(@rk, 'Ok');
  577.         End;
  578.         al[0] := LONG(@ves[6]);
  579.         y := EasyRequestArgs(w, ez, NIL, @al);
  580.     End;
  581. End;
  582.  
  583.  
  584. (****************************************************************************)
  585. Function WriteString(VAR f : BPTR; 
  586.                      s     : String) : Boolean;
  587. VAR
  588.     err : LONG;
  589.     
  590. begin
  591.     S := S+#10+#0; { add EOL and null term. }
  592.     err := FPuts(f,@s[1]);
  593.     if err = 0 then
  594.         WriteString := True
  595.     else
  596.         WriteString := False;
  597. End;
  598.  
  599.  
  600. (****************************************************************************)
  601. Procedure Handle_PrintNumbers(VAR w    : pWindow;
  602.                               VAR b    : tBoards;
  603.                               VAR list : pList;
  604.                               VAR rk   : pRemember);
  605.  
  606. Var
  607.     node    : pNode;
  608.     out     : BPTR;
  609.     Ok, Ok2 : Boolean;
  610.     n       : LONG;
  611.     ez      : pEasyStruct;
  612.     s       : String[20];
  613.     
  614. Begin
  615.     Ok := False;
  616.     out := Open(CSCPAR(@rk, 'PRT:'), MODE_NEWFILE);
  617.     if Out <> NULL then begin
  618.         If WriteString(out, 'Lottery Numbers, generated by MacCash (c)Lee Kindness.') then begin
  619.             if WriteString(out, '') then begin
  620.                 Ok := WriteString(out, '');
  621.                 Ok := WriteString(out, '');
  622.                 Ok := True;
  623.                 node := list^.lh_Head;
  624.                 n := 0;
  625.                 while (node^.ln_Succ <> NIL) and (Ok) do begin
  626.                     n := n + 1;
  627.                     If (b.bo_Nums[n,1] <> 0) and 
  628.                        (b.bo_Nums[n,2] <> 0) and
  629.                        (b.bo_Nums[n,3] <> 0) and
  630.                        (b.bo_Nums[n,4] <> 0) and
  631.                        (b.bo_Nums[n,5] <> 0) and
  632.                        (b.bo_Nums[n,6] <> 0) then
  633.                         Ok := WriteString(out,PtrToPas(node^.ln_Name));
  634.                     node := node^.ln_Succ;
  635.                 End;
  636.                 Ok := WriteString(out, '');
  637.                 Str(b.bo_Weeks, s);
  638.                 s := 'For ' + s + ' draw(s)'; 
  639.                 Ok := WriteString(out, s);
  640.                 Ok := WriteString(out, ''#12); { write a formfeed character }
  641.             End;
  642.         End;
  643.         Ok2 := AmigaDos.Close_(out);
  644.     End;
  645.     If Ok = False then begin
  646.         ez := AllocVec(Sizeof(tEasyStruct), MEMF_CLEAR);
  647.         If ez <> NIL then begin
  648.             with ez^ do begin
  649.                 es_StructSize :=  Sizeof(tEasyStruct);
  650.                 es_Title := CSCPAR(@rk, 'Shrub');
  651.                 es_TextFormat := CSCPAR(@rk,'Error Printing');
  652.                 es_GadgetFormat := CSCPAR(@rk,'Ok');
  653.             End;
  654.             n := EasyRequestArgs(w, ez, NIL, NIL);
  655.             FreeVec(ez);
  656.         End;
  657.     End;
  658. End;
  659.  
  660.  
  661. (****************************************************************************)
  662. Procedure Handle_IGadUpdate(VAR b    : tBoard;
  663.                                 ord  : Integer;
  664.                             VAR w    : pWindow;
  665.                             VAR G    : GadA;
  666.                                 list : pList;
  667.                             VAR rk   : pRemember);
  668.                           
  669. Var
  670.     t    : Array[1..3] Of LONG;
  671.     n    : Integer;
  672.     node : pNode;
  673.  
  674. Begin
  675.     SortBoard(b);
  676.     t[1] := GTIN_Number;
  677.     t[3] := TAG_DONE;
  678.     For n := 1 to NUM_NUMS do begin
  679.         t[2] := b[n];
  680.         GT_SetGadgetAttrsA(G[G_N1-1+n], w, NIL, @t);
  681.     End;
  682.     DetachObjectList(G[G_BLV], w, list);
  683.     node := list^.lh_Head;
  684.     For n := 2 to ord do 
  685.         node := node^.ln_Succ;
  686.     FormatNodeName(node, b, ord, rk);
  687.     AttachObjectList(g[G_BLV], w, list);
  688. End;
  689.  
  690.  
  691. (****************************************************************************)
  692. Procedure Handle_Events(VAR w  : pWindow; 
  693.                         VAR b  : tBoards;
  694.                         VAR G  : GadA;
  695.                         VAR ms : pMenu;
  696.                         VAR rk : pRemember);
  697.  
  698. Var
  699.     msg      : pIntuiMessage;
  700.     MsgClass, 
  701.     MsgCode,
  702.     dummy,
  703.     blvord,
  704.     n, j,
  705.     GadID,
  706.     lval,
  707.     UData    : LONG;
  708.     exitflag,
  709.     Ok       : Boolean;
  710.     key      : Pointer;
  711.     item     : pMenuItem;
  712.     
  713. Begin
  714.     blvord := 1;
  715.     ExitFlag := False;
  716.     While Not exitflag Do Begin
  717.         dummy := Wait(BitMask(w^.UserPort^.MP_SIGBIT));
  718.         msg   := GT_GetIMsg(w^.userPort);
  719.         while msg <> NIL do begin
  720.             MsgClass := msg^.Class;
  721.             MsgCode  := msg^.Code;
  722.             If MsgClass = IDCMP_GADGETUP Then begin
  723.                 GadID    := pGadget(msg^.IAddress)^.GadgetID;
  724.                 if GadID IN [G_N1..G_N2] then begin
  725.                     UData := LONG(pGadget(msg^.IAddress)^.UserData);
  726.                     lval  :=  pStringInfo(pGadget(msg^.IAddress)^.SpecialInfo)^.LongInt_;
  727.                 End;
  728.             End;
  729.             GT_ReplyIMsg(msg);
  730.             Case MsgClass of
  731.                 IDCMP_CLOSEWINDOW : Exitflag := True;
  732.                 IDCMP_REFRESHWINDOW : Begin
  733.                     GT_BeginRefresh(w);
  734.                     GT_EndRefresh(w, True);
  735.                 End;
  736.                 IDCMP_MENUPICK : begin
  737.                     While (msgcode <> MENUNULL) do begin
  738.                         item := ItemAddress(ms, msgcode);
  739.                         Case LONG(GTMENUITEM_USERDATA(item)) of
  740.                             M_PN   : Begin
  741.                                 key := DisableWindow(w);
  742.                                 Handle_PrintNumbers(w, b ,lvlist, rk);
  743.                                 EnableWindow(w, key);
  744.                             End;
  745.                             M_INFO : Begin
  746.                                 key := DisableWindow(w);
  747.                                 Handle_InfoMenu(w, rk);
  748.                                 EnableWindow(w, key);
  749.                             End;
  750.                             M_QUIT : ExitFlag := True;
  751.                         End;
  752.                         msgcode := item^.NextSelect;
  753.                     End;
  754.                 End;
  755.                 IDCMP_GADGETUP : Case GadID of
  756.                     G_BLV : Begin
  757.                         blvord := msgcode + 1;
  758.                         Handle_IGadUpdate(b.bo_Nums[blvord], blvord, w, G, lvlist, rk);
  759.                     End;
  760.                     G_N1, G_N2, G_N3, G_N4, G_N5, G_N6 : Begin
  761.                         Ok := True;
  762.                         For n := 1 to NUM_NUMS do
  763.                               If b.bo_Nums[blvord,n] = Lval then ok := false;
  764.                         If (Lval > 0) And (Lval < 50) And Ok Then
  765.                             b.bo_Nums[blvord, UData] := Lval;
  766.                         Handle_IGadUpdate(b.bo_Nums[blvord], blvord, w, G, lvlist, rk);
  767.                     End;
  768.                     G_NW : b.bo_Weeks := msgcode;
  769.                     G_RB : Begin
  770.                         key := DisableWindow(w);
  771.                         Handle_RandomBoard(G[G_BLV], w, lvlist, blvord, b.bo_Nums[blvord], rk);
  772.                         Handle_IGadUpdate(b.bo_Nums[blvord], blvord, w, G, lvlist, rk);
  773.                         EnableWindow(w, key);
  774.                     End;
  775.                     G_RA : Begin
  776.                         key := DisableWindow(w);
  777.                         For j := 1 to 10 do begin
  778.                             For n := 1 to NUM_BOARDS do begin
  779.                                 Handle_RandomBoard(G[G_BLV], w, lvlist, n, b.bo_Nums[n], rk);
  780.                                 delay(1);
  781.                             End;
  782.                         End;
  783.                         Handle_IGadUpdate(b.bo_Nums[blvord], blvord, w, G, lvlist, rk);
  784.                         EnableWindow(w, key);
  785.                     End;
  786.                     G_CB : Begin
  787.                         key := DisableWindow(w); 
  788.                         Handle_ClearBoard(G[G_BLV], w, lvlist, blvord, b.bo_Nums[blvord], rk);
  789.                         Handle_IGadUpdate(b.bo_Nums[blvord], blvord, w, G, lvlist, rk);
  790.                         EnableWindow(w, key);
  791.                     End;
  792.                     G_CA : Begin
  793.                         key := DisableWindow(w); 
  794.                         For n := 1 to NUM_BOARDS do
  795.                             Handle_ClearBoard(G[G_BLV], w, lvlist, n, b.bo_Nums[n], rk);
  796.                         Handle_IGadUpdate(b.bo_Nums[blvord], blvord, w, G, lvlist, rk);
  797.                         EnableWindow(w, key);
  798.                     End;
  799.                     G_ST : Begin
  800.                         key := DisableWindow(w); 
  801.                         ShowInfo(b, blvord, w, rk); 
  802.                         EnableWindow(w, key);
  803.                     End;
  804.  
  805.                 End;
  806.             End;
  807.             msg := GT_GetIMsg(w^.userPort);
  808.         End;
  809.     End;
  810. End;
  811.  
  812. (****************************************************************************)
  813. Function Open_Libraries : Boolean;
  814.  
  815. Begin
  816.     IntuitionBase := pIntuitionBase(OpenLibrary('intuition.library',36));
  817.     GadToolsBase  := OpenLibrary('gadtools.library',36);
  818.     GfxBase       := pGfxBase(OpenLibrary('graphics.library',0));
  819.     DiskFontBase  := OpenLibrary('diskfont.library',0);
  820.     IconBase      := OpenLibrary('icon.library',0);
  821.     If (IntuitionBase <> NIL) and
  822.        (GadToolsBase <> NIL) and
  823.        (GfxBase <> NIL) and
  824.        (DiskFontBase <> NIL) and
  825.        (IconBase <> NIL) Then 
  826.         Open_Libraries := True
  827.     Else
  828.         Open_Libraries := False;
  829. End;
  830.  
  831. (****************************************************************************)
  832. Procedure Close_Libraries;
  833.  
  834. Begin
  835.     CloseLibrary(pLibrary(IconBase));
  836.     CloseLibrary(pLibrary(DiskFontBase));
  837.     CloseLibrary(pLibrary(GfxBase));
  838.     CloseLibrary(pLibrary(GadToolsBase));
  839.     CloseLibrary(pLibrary(IntuitionBase));
  840. End;
  841.     
  842. Procedure Main;
  843.  
  844. Var
  845.     V  : tProgVars;
  846.     G  : GadA;
  847.     w  : pWindow;
  848.     rk : pRemember;
  849.     vi : Pointer;
  850.     b  : tBoards;
  851.     ms : pMenu;
  852.     
  853. Begin
  854.     rk := NIL;
  855.     If Open_Libraries then begin
  856.         InitGLN;
  857.         ClearBoards(b);
  858.         GetToolTypes(V);
  859.         w := OpenMainWindow(V, vi, G, rk, b, ms);
  860.         If w <> NIL then begin
  861.             Handle_Events(w, b, G, ms, rk);
  862.             CloseMainWindow(w, vi, G, ms);
  863.         End;
  864.     FreeRemember(@rk, True);
  865.     Close_Libraries;
  866.     End;
  867. End {MacCash};
  868.  
  869. Begin main End.