Version:0.9 StartHTML:0000000105 EndHTML:0000084818 StartFragment:0000001037 EndFragment:0000084802 mXScriptasHTML
{***************************************************************
2  *            bITbox
3  * Project  : boolean logic education system bITbox
4  * Unit Name: 308_bitbox3.txt
5  * Purpose  : Demonstrates all boolean circuits and all 16 boolean logics
6  * Date     : 18/10/2012  -  14:38:56, loc's=466, 39 intf
7  *
8  ****************************************************************}
9 //shows structure of procedure types, max@kleiner.com ex. _299
10 //compilerswitch $N- turns the coprocessor off, {$mode objfpc}{$H+} loc's =1
11 
12 PROGRAM Animation_BooleanLAB;
13 
14 procedure TFrm1_FormPaint(Sender: TObject); forward;
15 procedure TFrm1_timerRedrawTimer(Sender: TObject); forward;
16 procedure TFrm1_CloseClick(Sender: TObject); forward;
17 procedure TFrm1_PauseClick(Sender: TObject); forward;
18 procedure TFrm1_trackSpeedChange(Sender: TObject); forward;
19 procedure TFrm1_closeForm(Sender: TObject; var Action: TCloseAction); forward;
20 
21 Const MILLISECONDS = 50; //for timer, sync with trackbar 1000/50= position 20
22  
23 type
24   TBoolean_func = Function(a,b: boolean): boolean; 
25   
26 var 
27   aFrm: TForm;
28   mT: TTimer;
29   tB: TTrackBar;
30   CurStep: Double;
31   btna, btnb, btnc: TBitBtn;
32   btnabool,btnbbool, astate,bstate,ledstate: boolean;
33   statbar: TStatusbar;
34   //boolfct: TBoolean_func;
35   Lbox: TLISTBOX;
36   boxidx: byte;
37 
38 
39 procedure DrawRosette2;
40 var m,p: TPoint;
41   rho,phi: real;
42   i,r: integer;
43 begin
44    with afrm.Canvas do begin
45      Pen.Width:= 2;
46      Pen.Color:= clyellow;
47      //Brush.Color:= clblue;
48      Brush.Style:= bsClear;
49      //compute centerpoint and draw circle
50      m.x:=170; m.y:=165; r:=75;
51      rho:=360/18;
52      for i:=1 to 18 do begin
53        phi:=i*rho*pi/180;
54        p.x:=m.x+round(r*cos(phi));
55        p.y:=m.y+round(r*sin(phi));
56        Ellipse(p.x-r,p.y-r,p.x+r,p.y+r);
57        Ellipse(p.x-3,p.y-3,p.x+3,p.y+3);
58      end;
59      //application.processMessages;
60   end;
61 end;
62 
63 
64 function TForm1_RotatePoint(APoint,ACenter: TPoint; AAngle: Double): TPoint;
65 var dx,dy: Double;
66 begin
67   dx:= (ACenter.Y * Sin(AAngle)) - (ACenter.X * Cos(AAngle)) + ACenter.X;
68   dy:= -(ACenter.X * Sin(AAngle)) - (ACenter.Y * Cos(AAngle)) + ACenter.Y;
69   Result.X:= Round((APoint.X * Cos(AAngle)) - (APoint.Y * Sin(AAngle)) + dx);
70   Result.Y:= Round((APoint.X * Sin(AAngle)) + (APoint.Y * Cos(AAngle)) + dy);
71 end;
72   
73 procedure TForm1_RotatePolygon(var APoints: array of TPoint; AAngle: Double);
74 var aCentr: TPoint;
75     i: Integer;
76 begin
77   aCentr:= Point(8, 20);
78   for i:= 0 to Length(APoints)-1 do begin
79     aCentr.X:= aCentr.X + APoints[i].X;
80     aCentr.Y:= aCentr.Y + APoints[i].Y;
81   end;
82   aCentr.X:= aCentr.X div Length(APoints);
83   aCentr.Y:= aCentr.Y div Length(APoints);
84   for i:= 0 to Length(APoints)-1 do
85     APoints[i]:= TForm1_RotatePoint(APoints[i], aCentr, AAngle);
86 end;
87 
88 procedure TFrm1_FormPaint(Sender: TObject);
89 var
90   //lPoints: array[0..2] of TPoint;
91   lPoints: array of TPoint;
92 begin
93   SetLength(lpoints,3);
94   lPoints[0].X:= 100;
95   lPoints[0].Y:= 250;
96   lPoints[1].X:= 200;
97   lPoints[1].Y:= 20;
98   lPoints[2].X:= 200;
99   lPoints[2].Y:= 200;
100   TForm1_RotatePolygon(lpoints, CurStep);
101   afrm.Canvas.Pen.color:= clBlue;
102   afrm.Canvas.Pen.Width:= 15;
103   afrm.Canvas.Polygon(lPoints);
104   Drawrosette2;
105   if ledstate then begin
106     afrm.Canvas.Rectangle(600,320,350,180)
107     afrm.Canvas.Rectangle(170,165,450,180)
108   end
109   else begin
110     afrm.Canvas.Pen.color:= clblack;
111     afrm.Canvas.Rectangle(600,320,350,180);
112   end;
113   //application.processMessages;
114 end;
115 
116 
117  FUNCTION boolFCT(solutionstring: shortstring; bfct: TBoolean_func;
118                                                   fct_name: string): boolean;
119   BEGIN
120     //Writeln('debug boolean x | '+solutionstring+'  ' + fct_name);
121     statbar.panels.items[1].text:= fct_name +' of: '+solutionstring;
122     result:= bfct(astate,bstate);    //boolfct rec.!
123   END;
124  
125 
126 //************************* 16 all booleans ******************************//    
127   function Contradiction(a,b: boolean): boolean;  //1 FALSE Contradiction
128   begin
129     result:= false;
130   end;  
131   function Conjunction_AND(a,b: boolean):boolean; //2 AND Conjunction x*y
132   begin
133     result:= a AND b;
134   end;  
135   function Inhibition(a,b: boolean): boolean;     //3 Inhibition x*^y
136   begin
137     result:= a AND NOT b;
138   end;  
139   function Praependence(a,b: boolean): boolean;   //4 Praependence x
140   begin
141     result:= a;
142   end;  
143   function Praesection(a,b: boolean): boolean;    //5 Praesection ^x*y
144   begin
145     result:= NOT a AND b;
146   end;  
147   function Postpendence(a,b: boolean): boolean;   //6 Postpendence y
148   begin
149     result:= b;
150   end;  
151   function EXOR(a,b: boolean): boolean;           //7 exclusive OR XOR= x*^y+^x*y
152   begin
153     //result:= a XOR b; //alternative
154     //result:= a AND NOT b OR NOT a AND b;
155     result:= NOT(A=B);    //!
156   end;  
157   function Disjunction_OR(a,b: boolean): boolean; //8 Disjunction OR = x+y
158   begin
159     //result:= a XOR b;
160     result:= a OR b;
161   end;  
162   function NOR(a,b: boolean): boolean;            //9 Rejection
163   begin
164     result:= NOT(a OR b);
165   end;  
166   function Aequivalence(a,b: boolean): boolean;   //10 double implication ^x*^y+x*y
167   begin
168     result:= (NOT a OR b) AND (NOT b or a);
169     //result:= NOT a AND NOT b OR a AND b
170     //result:= NOT(a XOR b);
171     //result:= NOT(EXOR(a,b));
172    end;   
173   function NegationY(a,b: boolean): boolean;      //11 ynegation ^y
174   begin
175     result:= NOT b;
176    end;   
177   function ImplicationY(a,b: boolean): boolean;   //12 yimplication y-->x; x+^y
178   begin
179     result:=  a OR NOT b;
180    end;   
181   function NegationX(a,b: boolean): boolean;      //13 ynegation ^x
182   begin
183     result:= NOT a;
184    end;   
185   function ImplicationX(a,b: boolean): boolean;   //14 ximplication x-->y; ^x+y
186   begin
187     result:=  NOT a OR b;
188   end;   
189   function NAND(a,b: boolean): boolean;           //15 NAND Exclusion
190   begin
191     result:= NOT(a AND b);
192   end;  
193   function Tautologic(a,b: boolean): boolean;     //16 TRUE Tautologic
194   begin
195     result:= true;
196   end;  
197 //************************* 16 all booleans end *****************************//    
198 
199   
200 procedure addAllBooleans;
201 begin
202   //S:= StringOfChar(' ',i div 2) +S+ StringOfChar(' ',i-i div 2); 
203    lbox.Clear;
204    with LBox.Items do begin
205    add('All 16 Boolean Functions');
206    add('--------------------------------------------------------------');
207    add(format('01 FALSE(Contradiction)=0 %*s',[21,'0000']));
208    add(format('02 AND(Conjunction)=xy %*s',[27,'0001']));
209    add(format('03 Inhibition=x^y %*s',[42,'0010']));
210    add(format('04 Prependence=x %*s',[37,'0011']));
211    add(format('05 Presection=^xy %*s',[38,'0100']));
212    add(format('06 Postpendence=y %*s',[35,'0101']));
213    add(format('07 XOR(Exclusive OR)=x^y+^xy %*s',[12,'0110']));
214    add(format('08 OR(Disjunction)=x+y %*s',[29,'0111']));
215    add(format('09 NOR(Rejection)=^(x+y) %*s',[23,'1000']));
216    add(format('10 Aequivalence(BiCond)=^x^y+xy %*s',[05,'1001']));
217    add(format('11 NegationY=^y %*s',[40,'1010']));
218    add(format('12 ImplicationY(y-->x)=x+^y %*s',[21,'1011']));
219    add(format('13 NegationX=^x %*s',[41,'1100']));
220    add(format('14 ImplicationX(x-->y)=^x+y %*s',[21,'1101']));
221    add(format('15 NAND(Exclusion)=^(xy) %*s',[22,'1110']));
222    add(format('16 TRUE(Tautologic)=1 %*s',[27,'1111']));
223  end;    
224 end; 
225 
226 procedure boxClick(Sender: TObject);
227 //var idx: integer;
228 begin 
229    boxidx:= lbox.itemindex;
230    //writeln((Lbox.Items[boxidx]))
231    statbar.panels.items[1].text:= Lbox.Items[boxidx]+' is set active';
232 end;
233 
234 //*************************************************************************
235 procedure SetLEDStates;
236 //var ledstate: boolean;
237 begin
238   //ledstate:= ImplicationX(astate, bstate);
239   //statbar.panels.items[1].text:= 'Implication';
240   case boxidx of
241     2:  ledstate:= boolFCT('0000', @Contradiction, 'Contradiction');
242     3:  ledstate:= boolFCT('0001', @Conjunction_AND, 'Conjunction');
243     4:  ledstate:= boolFCT('0010', @Inhibition, 'Inhibition');
244     5:  ledstate:= boolFCT('0011', @Praependence, 'Praependence');
245     6:  ledstate:= boolFCT('0100', @Praesection, 'Praesection');
246     7:  ledstate:= boolFCT('0101', @Postpendence, 'Postpendence');
247     8:  ledstate:= boolFCT('0110', @EXOR, 'Exclusive OR');
248     9:  ledstate:= boolFCT('0111', @Disjunction_OR, 'Disjunction OR');
249     10: ledstate:= boolFCT('1000', @NOR, 'NOR Rejection');
250     11: ledstate:= boolFCT('1001', @Aequivalence, 'Bi Implication');
251     12: ledstate:= boolFCT('1010', @NegationY, 'Negation of Y');
252     13: ledstate:= boolFCT('1011', @ImplicationY, 'Implication of Y');
253     14: ledstate:= boolFCT('1100', @NegationX, 'Negation of X');
254     15: ledstate:= boolFCT('1101', @ImplicationX, 'Implication of X');
255     16: ledstate:= boolFCT('1110', @NAND, 'Not AND');
256     17: ledstate:= boolFCT('1111', @Tautologic, 'Tautologic');
257     //ledstate:= boolFCT('1,0,0,1', @Aequivalence, 'Bi Implication');
258   end;
259   //ledstate:= Aequivalence(astate,bstate)
260   //statbar.panels.items[1].text:= 'Bi Implication';
261   if ledstate then begin
262     btnc.glyph.LoadFromResourceName(getHINSTANCE,'LEDREDON')
263     statbar.panels.items[0].text:= 'LED is ON';
264   end else begin 
265     btnc.glyph.LoadFromResourceName(getHINSTANCE,'LEDREDOFF');
266     statbar.panels.items[0].text:= 'LED is OFF';
267   end;
268 end;
269 
270 
271 procedure btnAClick(Sender: TObject);
272 begin
273   btnabool:= NOT btnabool;
274   astate:= btnabool;
275   SetLEDStates;
276   if btnabool then begin
277     btna.glyph.LoadFromResourceName(getHINSTANCE,'CL_MPPLAY'); 
278     btna.spacing:= 22;
279     btna.caption:= 'ON'; 
280   end else begin
281     btna.glyph.LoadFromResourceName(getHINSTANCE,'CL_MPSTOP'); 
282     btna.spacing:= 15;
283     btna.caption:= 'OFF'; 
284   end; 
285 end; 
286   
287 procedure btnBClick(Sender: TObject);
288 begin
289   btnbbool:= NOT btnbbool;
290   bstate:= btnbbool;
291   SetLEDStates;
292   if btnbbool then begin
293     btnb.glyph.LoadFromResourceName(getHINSTANCE,'CL_MPPLAY'); 
294     //btnb.Layout:= blGlyphRight;
295     btnb.spacing:= 22;
296     btnb.caption:= 'ON'; 
297   end else begin
298     btnb.glyph.LoadFromResourceName(getHINSTANCE,'CL_MPSTOP'); 
299     btnb.spacing:= 15;
300     btnb.caption:= 'OFF'; 
301   end; 
302 end; 
303 
304 
305 //**************************Form Builder*******************************
306 procedure loadForm;
307 begin
308   aFrm:= TForm.Create(self);
309   mT:= TTimer.Create(self);
310   mt.onTimer:= @TFrm1_timerRedrawTimer;
311   mt.interval:= MILLISECONDS;
312   btnabool:= false; btnbbool:= false; //init
313   //mt.free;  in on close
314   with aFrm do begin
315     caption:= '************Boolean_Animation************';  
316     height:= 510;
317     width:= 950;
318     Position:= poScreenCenter;
319     onClose:= @TFrm1_closeForm;
320     onPaint:= @TFrm1_FormPaint;
321     Canvas.Pen.color:= clBlue;
322     Canvas.Pen.Width:= 15;
323     Show;
324   end;
325   with TBitBtn.Create(aFrm) do begin
326     Parent:= aFrm;
327     setbounds(310, 350,150, 55);
328     caption:= 'Pause';
329     font.size:= 12;
330     glyph.LoadFromResourceName(getHINSTANCE,'CL_MPPAUSE'); 
331     mXButton(05,05,width, height,12,12,handle);
332     //event handler
333     onclick:= @TFrm1_PauseClick;
334   end;
335   with TBitBtn.Create(aFrm) do begin
336     Parent:= aFrm;
337     setbounds(480, 350,150, 55);
338     caption:= 'Close';
339     font.size:= 12;
340     glyph.LoadFromResourceName(getHINSTANCE,'CL_MPSTOP'); 
341     mXButton(05,05,width, height,12,12,handle);
342     onclick:= @TFrm1_CloseClick;
343   end;
344   btna:= TBitBtn.Create(aFrm);
345   with btna do begin
346     Parent:= aFrm;
347     setbounds(310, 290,150, 55);
348     caption:= 'ON';
349     font.size:= 12;
350     glyph.LoadFromResourceName(getHINSTANCE,'CL_MPPLAY'); 
351     mXButton(05,05,width, height,12,12,handle);
352     onclick:= @btnaClick;
353   end;
354   btnb:= TBitBtn.Create(aFrm);
355   with btnb do begin
356     Parent:= aFrm;
357     setbounds(480, 290,150, 55);
358     caption:= 'OFF';
359     font.size:= 12;
360     glyph.LoadFromResourceName(getHINSTANCE,'CL_MPSTOP'); 
361     mXButton(05,05,width, height,12,12,handle);
362     onclick:= @btnbClick;
363   end;
364    btnc:= TBitBtn.Create(aFrm);
365   with btnc do begin
366     Parent:= aFrm;
367     setbounds(445, 150,60, 60);
368     caption:= '';  
369     glyph.LoadFromResourceName(getHINSTANCE,'LEDREDON'); 
370     mXButton(0,0,width, height,12,12,handle);
371     //onclick:= @TFrm1_CloseClick;
372   end;
373   tB:= TTrackBar.create(aFrm);
374    with tB do begin
375       parent:= aFrm;
376       setBounds(40,360,230,40);
377       Min:= 10; Max:= 100
378       Frequency:= 10
379       Position:= 1000 div MILLISECONDS;
380       linesize:= 4;
381       ThumbLength:= 30;
382       SetFocus;
383       OnChange:= @TFrm1_trackSpeedChange;
384    end;
385   statbar:= TStatusBar.create(aFrm);
386   with statbar do begin
387     parent:= aFrm;
388     //simplepanel:= true;
389     showhint:= true;
390     hint:= 'LED Logger States';
391      Panels.add;
392      panels.items[0].width:= 200;
393      panels.items[0].text:= 'LED Data Log';
394      Panels.add;
395      panels.items[1].width:= 150;
396      panels.items[1].text:= 'Logic Logger State';
397   end;
398   lbox:= TListbox.Create(aFrm)
399    with lbox do begin
400     Parent:= afrm;
401     SetBounds(645,20,285,430)
402     font.size:= 10;
403     //color:= clsilver;
404     font.name:= 'MS Sans Serif'  //or Courier
405     font.color:= clblack;
406     //Style:= csOwnerDrawFixed;
407     onClick:= @boxClick;
408     //onDrawItem:= @Listbox1DrawItem;
409   end;
410   addAllbooleans;
411 end;  
412 
413 
414 //**************************Event Handlers*******************************
415 procedure TFrm1_trackSpeedChange(Sender: TObject);
416 begin
417   mt.Interval:= 1000 div tB.Position;
418 end;
419 
420 procedure TFrm1_timerRedrawTimer(Sender: TObject);
421 begin
422   CurStep:= CurStep + 0.1;
423   if CurStep > 360 then CurStep:= 0;
424   afrm.Invalidate;  //redraw
425 end;
426 
427 procedure TFrm1_closeForm(Sender: TObject; var Action: TCloseAction);
428 begin
429   if mt <> NIL then begin
430     mT.enabled:= false;
431     mT.Free;
432     mT:= NIL;
433   end;
434   ///afrm.Free;  
435   action:= caFree;
436   afrm:= NIL;
437 end;
438 
439 procedure TFrm1_CloseClick(Sender: TObject);
440 begin
441   afrm.Close;
442 end;
443 
444 procedure TFrm1_PauseClick(Sender: TObject);
445 begin
446   if mT <> NIL then
447     mt.enabled:= not mt.enabled;
448 end;
449 
450 var    //test vars
451    str3: string;
452    sstr: shortstring;
453   //main form list call  
454   Begin
455     //calls some test functions
456     writeln(floattostr(maxCalc('e^ln(2)')));
457     printF('this is %.18f ',[maxCalc('ln(2)^e')]);
458     printF('this is %.18f ',[maxCalc('sqr(cos(ln(2)^e))')]);
459     printF('this is %.4f ',[maxCalc('sqrt(e^(ln(2)))')]);
460     writeln(getVersionString(exepath+'maxbox3.exe'));
461     str3:= loadFileAsString(exepath+'maxbox_functions_all.pdf');
462     writeln('file compare j: '+inttoStr(CompText(str3, str3)));
463     writeln(intToStr(length(str3)));
464  //--------------------------Main Topic--------------------------
465     loadForm;
466 End.
467   
468 
469 
470  //ShellExecute in W64
471     //ExecuteCommand('cmd','/k FC /L /N C:\maxbook\maxbox3\maxbox391.exe C:\maxbook\maxbox3\maxbox3.exe')
472  //  ExecuteCommand('cmd','/k FC /L /N C:\maxbook\maxbox3\maxboxdef1.ini C:\maxbook\maxbox3\maxboxdef2.ini')
473    
474 
475 getRulesbyContract