From 7d0db55570976bb7e8b437c682b339532f361d59 Mon Sep 17 00:00:00 2001 From: Ivan Mahonin Date: Jan 18 2019 12:05:05 +0000 Subject: lazarus: magic-marker --- diff --git a/lazarus/magic-marker/project1.ico b/lazarus/magic-marker/project1.ico new file mode 100644 index 0000000..0341321 Binary files /dev/null and b/lazarus/magic-marker/project1.ico differ diff --git a/lazarus/magic-marker/project1.lpi b/lazarus/magic-marker/project1.lpi new file mode 100644 index 0000000..3afe492 --- /dev/null +++ b/lazarus/magic-marker/project1.lpi @@ -0,0 +1,79 @@ + + + + + + + + + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <Icon Value="0"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="LCL"/> + </Item1> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="project1.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="unit1.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="Unit1"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="project1"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/lazarus/magic-marker/project1.lpr b/lazarus/magic-marker/project1.lpr new file mode 100644 index 0000000..58c35dc --- /dev/null +++ b/lazarus/magic-marker/project1.lpr @@ -0,0 +1,21 @@ +program project1; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, Unit1 + { you can add units after this }; + +{$R *.res} + +begin + RequireDerivedFormResource:=True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/lazarus/magic-marker/project1.res b/lazarus/magic-marker/project1.res new file mode 100644 index 0000000..e994dfa Binary files /dev/null and b/lazarus/magic-marker/project1.res differ diff --git a/lazarus/magic-marker/unit1.lfm b/lazarus/magic-marker/unit1.lfm new file mode 100644 index 0000000..daa8436 --- /dev/null +++ b/lazarus/magic-marker/unit1.lfm @@ -0,0 +1,23 @@ +object Form1: TForm1 + Left = 324 + Height = 431 + Top = 277 + Width = 451 + Caption = 'Form1' + OnCreate = FormCreate + OnMouseMove = FormMouseMove + OnPaint = FormPaint + LCLVersion = '1.6.2.0' + object Timer1: TTimer + Interval = 1 + OnTimer = Timer1Timer + left = 18 + top = 9 + end + object Timer2: TTimer + Interval = 50 + OnTimer = Timer2Timer + left = 57 + top = 10 + end +end diff --git a/lazarus/magic-marker/unit1.pas b/lazarus/magic-marker/unit1.pas new file mode 100644 index 0000000..02c8d4e --- /dev/null +++ b/lazarus/magic-marker/unit1.pas @@ -0,0 +1,137 @@ +unit Unit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls; + +type + + { TForm1 } + + TForm1 = class(TForm) + Timer1: TTimer; + Timer2: TTimer; + procedure FormCreate(Sender: TObject); + procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); + procedure FormPaint(Sender: TObject); + procedure Timer1Timer(Sender: TObject); + procedure Timer2Timer(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +const + pointR = 5; + ballR = 40; + g = 0.002; + +var + Form1: TForm1; + maxPoints: integer = 100; + points: array of TPoint; + bx, by, vx, vy: single; + +implementation + +{$R *.lfm} + +procedure addPoint(x, y: integer); +var + i, l: integer; +begin + if maxPoints <= 0 then exit; + l := Length(points); + if l < maxPoints then begin + SetLength(points, l+1); + points[l].X := x; + points[l].Y := y; + end else begin + for i:=1 to l-1 do begin + points[i-1] := points[i]; + end; + points[l-1].X := x; + points[l-1].Y := y; + end; +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + bx := 200; + by := 100; + vx := 0.1; + vy := 0; +end; + +procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, + Y: Integer); +begin + if ssLeft in Shift then begin + addPoint(x, y); + // todo: addPointChain + end; +end; + +procedure TForm1.FormPaint(Sender: TObject); +var + i: integer; +begin + Canvas.Pen.Color := clBlack; + Canvas.Pen.Width := pointR * 2; + for i:=0 to length(points)-1 do begin + Canvas.MoveTo(points[i].x, points[i].y); + Canvas.LineTo(points[i].x, points[i].y); + end; + + Canvas.Pen.Color := clBlue; + Canvas.Pen.Width := ballR * 2; + Canvas.MoveTo(round(bx), round(by)); + Canvas.LineTo(round(bx), round(by)); +end; + +procedure TForm1.Timer1Timer(Sender: TObject); +var + i: integer; + dx, dy, sqlen, minSqlen, dv: single; + collision: boolean; +begin + collision := false; + + bx := bx + vx; + by := by + vy; + + if bx > ClientWidth - ballR then begin vx := -abs(vx); collision := true; end; + if by > ClientHeight - ballR then begin vy := -abs(vy); collision := true; end; + if bx < ballR then begin vx := abs(vx); collision := true; end; + if by < ballR then begin vy := abs(vy); collision := true; end; + + minSqlen := sqr(ballR + pointR); + for i := 0 to length(points)-1 do begin + dx := points[i].X-bx; + dy := points[i].Y-by; + sqlen := sqr(dx) + sqr(dy); + if (sqlen > 0.1*minSqlen) and (minSqlen > sqlen) then begin + dv := -2*(dx*vx + dy*vy)/sqlen; + if dv < 0 then begin + vx := vx + dv*dx; + vy := vy + dv*dy; + collision := true; + end; + end; + end; + + if not collision then vy := vy + g; + if collision then refresh; +end; + +procedure TForm1.Timer2Timer(Sender: TObject); +begin + Refresh; +end; + +end. +