Download as
Browse Code »

Commit 8dc84f584bbe95d8bf32636e93791bb2fd8a0b1a

Authored by Carlos Picanco
1 parent feb220c3
Exists in master

network working dump

Showing 11 changed files with 1501 additions and 809 deletions   Show diff stats
cultural_matrix.lpi
  Diff comments   View file @8dc84f5
@@ -38,15 +38,15 @@ @@ -38,15 +38,15 @@
38 <PackageName Value="LCL"/> 38 <PackageName Value="LCL"/>
39 </Item3> 39 </Item3>
40 </RequiredPackages> 40 </RequiredPackages>
41 - <Units Count="4"> 41 + <Units Count="9">
42 <Unit0> 42 <Unit0>
43 <Filename Value="cultural_matrix.lpr"/> 43 <Filename Value="cultural_matrix.lpr"/>
44 <IsPartOfProject Value="True"/> 44 <IsPartOfProject Value="True"/>
45 </Unit0> 45 </Unit0>
46 <Unit1> 46 <Unit1>
47 - <Filename Value="form_participant.pas"/> 47 + <Filename Value="form_matrixgame.pas"/>
48 <IsPartOfProject Value="True"/> 48 <IsPartOfProject Value="True"/>
49 - <ComponentName Value="Form1"/> 49 + <ComponentName Value="FormMatrixGame"/>
50 <HasResources Value="True"/> 50 <HasResources Value="True"/>
51 <ResourceBaseClass Value="Form"/> 51 <ResourceBaseClass Value="Form"/>
52 </Unit1> 52 </Unit1>
@@ -61,6 +61,29 @@ @@ -61,6 +61,29 @@
61 <Filename Value="README.md"/> 61 <Filename Value="README.md"/>
62 <IsPartOfProject Value="True"/> 62 <IsPartOfProject Value="True"/>
63 </Unit3> 63 </Unit3>
  64 + <Unit4>
  65 + <Filename Value="units/zmq_pub_sub.pas"/>
  66 + <IsPartOfProject Value="True"/>
  67 + </Unit4>
  68 + <Unit5>
  69 + <Filename Value="units/game_zmq_actors.pas"/>
  70 + <IsPartOfProject Value="True"/>
  71 + </Unit5>
  72 + <Unit6>
  73 + <Filename Value="units/game_actors.pas"/>
  74 + <IsPartOfProject Value="True"/>
  75 + </Unit6>
  76 + <Unit7>
  77 + <Filename Value="form_chooseactor.pas"/>
  78 + <IsPartOfProject Value="True"/>
  79 + <ComponentName Value="Form1"/>
  80 + <HasResources Value="True"/>
  81 + <ResourceBaseClass Value="Form"/>
  82 + </Unit7>
  83 + <Unit8>
  84 + <Filename Value="units/game_message.pas"/>
  85 + <IsPartOfProject Value="True"/>
  86 + </Unit8>
64 </Units> 87 </Units>
65 </ProjectOptions> 88 </ProjectOptions>
66 <CompilerOptions> 89 <CompilerOptions>
@@ -70,6 +93,8 @@ @@ -70,6 +93,8 @@
70 </Target> 93 </Target>
71 <SearchPaths> 94 <SearchPaths>
72 <IncludeFiles Value="$(ProjOutDir)"/> 95 <IncludeFiles Value="$(ProjOutDir)"/>
  96 + <Libraries Value="/usr/lib/gcc/x86_64-linux-gnu/4.9/"/>
  97 + <OtherUnitFiles Value="units;../../dependency/delphizmq;../../units"/>
73 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 98 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
74 </SearchPaths> 99 </SearchPaths>
75 <Linking> 100 <Linking>
@@ -79,6 +104,12 @@ @@ -79,6 +104,12 @@
79 </Win32> 104 </Win32>
80 </Options> 105 </Options>
81 </Linking> 106 </Linking>
  107 + <Other>
  108 + <CustomOptions Value="-dUseCThreads"/>
  109 + <OtherDefines Count="1">
  110 + <Define0 Value="UseCThreads"/>
  111 + </OtherDefines>
  112 + </Other>
82 </CompilerOptions> 113 </CompilerOptions>
83 <Debugging> 114 <Debugging>
84 <Exceptions Count="3"> 115 <Exceptions Count="3">
cultural_matrix.lpr
  Diff comments   View file @8dc84f5
@@ -15,17 +15,47 @@ uses @@ -15,17 +15,47 @@ uses
15 {$IFDEF UNIX}{$IFDEF UseCThreads} 15 {$IFDEF UNIX}{$IFDEF UseCThreads}
16 cthreads, 16 cthreads,
17 {$ENDIF}{$ENDIF} 17 {$ENDIF}{$ENDIF}
18 - Interfaces, // this includes the LCL widgetset  
19 - Forms, form_participant, datamodule 18 + Interfaces // this includes the LCL widgetset
  19 + , StrUtils
  20 + , Forms
  21 + , form_matrixgame
  22 + , form_chooseactor, game_message
20 { you can add units after this }; 23 { you can add units after this };
21 24
  25 +const
  26 + PAdmin : array [0..3] of string = ('--admin','--adm','-admin','-adm');
  27 + PPlayer : array [0..3] of string = ('--player','--play','-player','-play');
  28 + PWatcher : array [0..3] of string = ('--watcher','--watch','-watcher','-watch');
  29 +
22 {$R *.res} 30 {$R *.res}
23 31
24 begin 32 begin
25 - RequireDerivedFormResource := True; 33 + //RequireDerivedFormResource := True;
26 Application.Initialize; 34 Application.Initialize;
27 - Application.CreateForm(TForm1, Form1);  
28 - Application.CreateForm(TDataModule1, DataModule1); 35 + Application.CreateForm(TFormMatrixGame, FormMatrixGame);
  36 + if Paramcount > 0 then
  37 + begin
  38 + if AnsiMatchStr(lowercase(ParamStr(0)), PAdmin) then
  39 + FormMatrixGame.GameActor := gaAdmin;
  40 + if AnsiMatchStr(lowercase(ParamStr(0)), PPlayer) then
  41 + FormMatrixGame.GameActor := gaPlayer;
  42 + if AnsiMatchStr(lowercase(ParamStr(0)), PWatcher) then
  43 + FormMatrixGame.GameActor := gaWatcher;
  44 + end
  45 + else
  46 + begin
  47 + Form1 := TForm1.Create(nil);
  48 + if Form1.ShowModal = 1 then
  49 + begin
  50 + case Form1.GameActor of
  51 + gaAdmin:FormMatrixGame.GameActor := gaAdmin;
  52 + gaPlayer: {FormMatrixGame.GameActor := gaPlayer};
  53 + gaWatcher: {FormMatrixGame.GameActor := gaWatcher};
  54 + end;
  55 + end
  56 + else Exit;
  57 + Form1.Free;
  58 + end;
29 Application.Run; 59 Application.Run;
30 end. 60 end.
31 61
form_chooseactor.lfm 0 → 100644
  Diff comments   View file @8dc84f5
@@ -0,0 +1,31 @@ @@ -0,0 +1,31 @@
  1 +object Form1: TForm1
  2 + Left = 416
  3 + Height = 240
  4 + Top = 194
  5 + Width = 320
  6 + BorderStyle = bsNone
  7 + Caption = 'Form1'
  8 + ClientHeight = 240
  9 + ClientWidth = 320
  10 + FormStyle = fsStayOnTop
  11 + Position = poScreenCenter
  12 + LCLVersion = '1.6.0.4'
  13 + object btnAdmin: TButton
  14 + Left = 64
  15 + Height = 25
  16 + Top = 70
  17 + Width = 184
  18 + Caption = 'Administrador'
  19 + OnClick = btnAdminClick
  20 + TabOrder = 0
  21 + end
  22 + object btnPlayer: TButton
  23 + Left = 64
  24 + Height = 25
  25 + Top = 125
  26 + Width = 179
  27 + Caption = 'Jogador'
  28 + OnClick = btnPlayerClick
  29 + TabOrder = 1
  30 + end
  31 +end
form_chooseactor.pas 0 → 100644
  Diff comments   View file @8dc84f5
@@ -0,0 +1,59 @@ @@ -0,0 +1,59 @@
  1 +unit form_chooseactor;
  2 +
  3 +{$mode objfpc}{$H+}
  4 +
  5 +interface
  6 +
  7 +uses
  8 + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  9 + form_matrixgame
  10 + ;
  11 +
  12 +type
  13 +
  14 + { TForm1 }
  15 +
  16 + TForm1 = class(TForm)
  17 + btnAdmin: TButton;
  18 + btnPlayer: TButton;
  19 + procedure btnAdminClick(Sender: TObject);
  20 + procedure btnPlayerClick(Sender: TObject);
  21 + private
  22 + FGameActor: TGameActor;
  23 + procedure SetGameActor(AValue: TGameActor);
  24 + { private declarations }
  25 + public
  26 + property GameActor : TGameActor read FGameActor write SetGameActor;
  27 + end;
  28 +
  29 +var
  30 + Form1: TForm1;
  31 +
  32 +implementation
  33 +
  34 +{$R *.lfm}
  35 +
  36 +{ TForm1 }
  37 +
  38 +procedure TForm1.btnAdminClick(Sender: TObject);
  39 +begin
  40 + GameActor:=gaAdmin;
  41 + ModalResult:=1;
  42 +end;
  43 +
  44 +procedure TForm1.btnPlayerClick(Sender: TObject);
  45 +begin
  46 + GameActor:=gaPlayer;
  47 + ModalResult:=1;
  48 +end;
  49 +
  50 +procedure TForm1.SetGameActor(AValue: TGameActor);
  51 +begin
  52 + if FGameActor=AValue then Exit;
  53 + FGameActor:=AValue;
  54 +end;
  55 +
  56 +
  57 +
  58 +end.
  59 +
form_matrixgame.lfm 0 → 100644
  Diff comments   View file @8dc84f5
@@ -0,0 +1,507 @@ @@ -0,0 +1,507 @@
  1 +object FormMatrixGame: TFormMatrixGame
  2 + Left = 117
  3 + Height = 599
  4 + Top = 142
  5 + Width = 1159
  6 + HorzScrollBar.Page = 1138
  7 + VertScrollBar.Page = 542
  8 + AutoScroll = True
  9 + Caption = 'FormMatrixGame'
  10 + ClientHeight = 599
  11 + ClientWidth = 1159
  12 + Font.Name = 'Monospace'
  13 + OnActivate = FormActivate
  14 + OnClose = FormClose
  15 + OnCreate = FormCreate
  16 + LCLVersion = '1.6.0.4'
  17 + object StringGridMatrix: TStringGrid
  18 + AnchorSideLeft.Control = Owner
  19 + AnchorSideTop.Control = Owner
  20 + AnchorSideRight.Control = Owner
  21 + AnchorSideRight.Side = asrBottom
  22 + AnchorSideBottom.Control = Owner
  23 + AnchorSideBottom.Side = asrBottom
  24 + Left = 0
  25 + Height = 345
  26 + Top = 0
  27 + Width = 709
  28 + AutoEdit = False
  29 + BorderSpacing.Right = 150
  30 + BorderSpacing.Bottom = 197
  31 + ColCount = 11
  32 + DefaultRowHeight = 30
  33 + Enabled = False
  34 + FixedRows = 0
  35 + Options = [goFixedHorzLine, goHorzLine, goDrawFocusSelected, goRowSelect, goSmoothScroll]
  36 + RowCount = 10
  37 + TabOrder = 0
  38 + TitleFont.Name = 'Monospace'
  39 + OnBeforeSelection = StringGridMatrixBeforeSelection
  40 + OnDrawCell = StringGridMatrixDrawCell
  41 + end
  42 + object GBIndividualPoints: TGroupBox
  43 + Left = 796
  44 + Height = 122
  45 + Top = 0
  46 + Width = 170
  47 + AutoSize = True
  48 + Caption = 'Pontuação Individual'
  49 + ChildSizing.LeftRightSpacing = 10
  50 + ChildSizing.TopBottomSpacing = 30
  51 + ChildSizing.HorizontalSpacing = 20
  52 + ChildSizing.VerticalSpacing = 15
  53 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
  54 + ChildSizing.Layout = cclLeftToRightThenTopToBottom
  55 + ChildSizing.ControlsPerLine = 2
  56 + ClientHeight = 105
  57 + ClientWidth = 166
  58 + TabOrder = 1
  59 + object LabelIndA: TLabel
  60 + Left = 10
  61 + Height = 15
  62 + Top = 30
  63 + Width = 63
  64 + Alignment = taCenter
  65 + AutoSize = False
  66 + Caption = 'A'
  67 + Color = clTeal
  68 + Font.Color = clBlack
  69 + Font.Name = 'Monospace'
  70 + Font.Style = [fsBold]
  71 + ParentColor = False
  72 + ParentFont = False
  73 + Transparent = False
  74 + end
  75 + object LabelIndB: TLabel
  76 + Left = 93
  77 + Height = 15
  78 + Top = 30
  79 + Width = 63
  80 + Alignment = taCenter
  81 + AutoSize = False
  82 + Caption = 'B'
  83 + Color = clTeal
  84 + Font.Color = clBlack
  85 + Font.Name = 'Monospace'
  86 + Font.Style = [fsBold]
  87 + ParentColor = False
  88 + ParentFont = False
  89 + Transparent = False
  90 + end
  91 + object LabelIndACount: TLabel
  92 + Left = 10
  93 + Height = 15
  94 + Top = 60
  95 + Width = 63
  96 + Alignment = taCenter
  97 + AutoSize = False
  98 + Caption = '0'
  99 + Color = clDefault
  100 + ParentColor = False
  101 + Transparent = False
  102 + end
  103 + object LabelIndBCount: TLabel
  104 + Left = 93
  105 + Height = 15
  106 + Top = 60
  107 + Width = 63
  108 + Alignment = taCenter
  109 + AutoSize = False
  110 + Caption = '0'
  111 + Color = clDefault
  112 + ParentColor = False
  113 + Transparent = False
  114 + end
  115 + end
  116 + object GBGrupo: TGroupBox
  117 + Left = 968
  118 + Height = 122
  119 + Top = 0
  120 + Width = 170
  121 + AutoSize = True
  122 + Caption = ' Pontuação do Grupo '
  123 + ChildSizing.LeftRightSpacing = 35
  124 + ChildSizing.TopBottomSpacing = 45
  125 + ChildSizing.Layout = cclLeftToRightThenTopToBottom
  126 + ChildSizing.ControlsPerLine = 1
  127 + ClientHeight = 105
  128 + ClientWidth = 166
  129 + TabOrder = 2
  130 + object LabelGroupCount: TLabel
  131 + Left = 35
  132 + Height = 15
  133 + Top = 45
  134 + Width = 96
  135 + Align = alClient
  136 + Alignment = taCenter
  137 + AutoSize = False
  138 + Caption = '0'
  139 + Color = clDefault
  140 + Layout = tlCenter
  141 + ParentColor = False
  142 + Transparent = False
  143 + end
  144 + end
  145 + object GBLastChoice: TGroupBox
  146 + AnchorSideLeft.Control = Owner
  147 + AnchorSideRight.Control = Owner
  148 + AnchorSideRight.Side = asrBottom
  149 + AnchorSideBottom.Control = Owner
  150 + AnchorSideBottom.Side = asrBottom
  151 + Left = 0
  152 + Height = 124
  153 + Top = 475
  154 + Width = 1159
  155 + Anchors = [akLeft, akRight, akBottom]
  156 + AutoSize = True
  157 + Caption = 'Escolhas na última jogada'
  158 + ChildSizing.LeftRightSpacing = 10
  159 + ChildSizing.TopBottomSpacing = 5
  160 + ChildSizing.HorizontalSpacing = 10
  161 + ChildSizing.ControlsPerLine = 6
  162 + ClientHeight = 107
  163 + ClientWidth = 1155
  164 + TabOrder = 3
  165 + object GBLastChoiceP0: TGroupBox
  166 + Left = 10
  167 + Height = 97
  168 + Top = 5
  169 + Width = 138
  170 + AutoSize = True
  171 + Caption = 'Você'
  172 + ChildSizing.LeftRightSpacing = 20
  173 + ChildSizing.TopBottomSpacing = 20
  174 + ChildSizing.HorizontalSpacing = 30
  175 + ChildSizing.VerticalSpacing = 10
  176 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
  177 + ChildSizing.Layout = cclLeftToRightThenTopToBottom
  178 + ChildSizing.ControlsPerLine = 2
  179 + ClientHeight = 80
  180 + ClientWidth = 134
  181 + TabOrder = 0
  182 + object LabelCurrentColor1: TLabel
  183 + Left = 20
  184 + Height = 15
  185 + Top = 20
  186 + Width = 48
  187 + AutoSize = False
  188 + Caption = 'Cor:'
  189 + ParentColor = False
  190 + end
  191 + object PanelCurrentColor1: TPanel
  192 + Left = 98
  193 + Height = 15
  194 + Top = 20
  195 + Width = 16
  196 + Color = clBlack
  197 + ParentColor = False
  198 + TabOrder = 0
  199 + end
  200 + object LabelCurrentLine1: TLabel
  201 + Left = 20
  202 + Height = 15
  203 + Top = 45
  204 + Width = 48
  205 + AutoSize = False
  206 + Caption = 'Linha:'
  207 + ParentColor = False
  208 + end
  209 + object LabelCurrentLineNumber1: TLabel
  210 + Left = 98
  211 + Height = 15
  212 + Top = 45
  213 + Width = 16
  214 + Caption = 'NA'
  215 + ParentColor = False
  216 + end
  217 + end
  218 + object GBLastChoiceP1: TGroupBox
  219 + Left = 170
  220 + Height = 97
  221 + Top = 5
  222 + Width = 138
  223 + AutoSize = True
  224 + Caption = 'João'
  225 + ChildSizing.LeftRightSpacing = 20
  226 + ChildSizing.TopBottomSpacing = 20
  227 + ChildSizing.HorizontalSpacing = 30
  228 + ChildSizing.VerticalSpacing = 10
  229 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
  230 + ChildSizing.Layout = cclLeftToRightThenTopToBottom
  231 + ChildSizing.ControlsPerLine = 2
  232 + ClientHeight = 80
  233 + ClientWidth = 134
  234 + TabOrder = 1
  235 + object LabelYouLastChoiceColor3: TLabel
  236 + Left = 20
  237 + Height = 15
  238 + Top = 20
  239 + Width = 48
  240 + AutoSize = False
  241 + Caption = 'Cor:'
  242 + ParentColor = False
  243 + end
  244 + object Panel4: TPanel
  245 + Left = 98
  246 + Height = 15
  247 + Top = 20
  248 + Width = 16
  249 + Color = clBlack
  250 + ParentColor = False
  251 + TabOrder = 0
  252 + end
  253 + object Label10: TLabel
  254 + Left = 20
  255 + Height = 15
  256 + Top = 45
  257 + Width = 48
  258 + AutoSize = False
  259 + Caption = 'Linha:'
  260 + ParentColor = False
  261 + end
  262 + object Label11: TLabel
  263 + Left = 98
  264 + Height = 15
  265 + Top = 45
  266 + Width = 16
  267 + Caption = 'NA'
  268 + ParentColor = False
  269 + end
  270 + end
  271 + object GBLastChoiceP2: TGroupBox
  272 + Left = 322
  273 + Height = 97
  274 + Top = 5
  275 + Width = 138
  276 + AutoSize = True
  277 + Caption = 'Maria'
  278 + ChildSizing.LeftRightSpacing = 20
  279 + ChildSizing.TopBottomSpacing = 20
  280 + ChildSizing.HorizontalSpacing = 30
  281 + ChildSizing.VerticalSpacing = 10
  282 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
  283 + ChildSizing.Layout = cclLeftToRightThenTopToBottom
  284 + ChildSizing.ControlsPerLine = 2
  285 + ClientHeight = 80
  286 + ClientWidth = 134
  287 + TabOrder = 2
  288 + object LabelYouLastChoiceColor4: TLabel
  289 + Left = 20
  290 + Height = 15
  291 + Top = 20
  292 + Width = 48
  293 + AutoSize = False
  294 + Caption = 'Cor:'
  295 + ParentColor = False
  296 + end
  297 + object Panel5: TPanel
  298 + Left = 98
  299 + Height = 15
  300 + Top = 20
  301 + Width = 16
  302 + Color = clBlack
  303 + ParentColor = False
  304 + TabOrder = 0
  305 + end
  306 + object Label12: TLabel
  307 + Left = 20
  308 + Height = 15
  309 + Top = 45
  310 + Width = 48
  311 + AutoSize = False
  312 + Caption = 'Linha:'
  313 + ParentColor = False
  314 + end
  315 + object Label13: TLabel
  316 + Left = 98
  317 + Height = 15
  318 + Top = 45
  319 + Width = 16
  320 + Caption = 'NA'
  321 + ParentColor = False
  322 + end
  323 + end
  324 + end
  325 + object GBAdmin: TGroupBox
  326 + Left = 796
  327 + Height = 208
  328 + Top = 137
  329 + Width = 336
  330 + Caption = 'Administrador'
  331 + ClientHeight = 191
  332 + ClientWidth = 332
  333 + TabOrder = 4
  334 + Visible = False
  335 + object rgMatrixType: TRadioGroup
  336 + Left = 10
  337 + Height = 59
  338 + Top = 8
  339 + Width = 119
  340 + AutoFill = True
  341 + AutoSize = True
  342 + Caption = 'MatrixType'
  343 + ChildSizing.LeftRightSpacing = 6
  344 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
  345 + ChildSizing.EnlargeVertical = crsHomogenousChildResize
  346 + ChildSizing.ShrinkHorizontal = crsScaleChilds
  347 + ChildSizing.ShrinkVertical = crsScaleChilds
  348 + ChildSizing.Layout = cclLeftToRightThenTopToBottom
  349 + ChildSizing.ControlsPerLine = 1
  350 + ClientHeight = 42
  351 + ClientWidth = 115
  352 + ItemIndex = 0
  353 + Items.Strings = (
  354 + 'Rows'
  355 + 'Rows & Cols'
  356 + )
  357 + OnClick = rgMatrixTypeClick
  358 + TabOrder = 0
  359 + end
  360 + object CheckBoxDrawDots: TCheckBox
  361 + Left = 10
  362 + Height = 21
  363 + Top = 80
  364 + Width = 119
  365 + AutoSize = False
  366 + Caption = 'DrawDots'
  367 + OnChange = CheckBoxDrawDotsChange
  368 + TabOrder = 1
  369 + end
  370 + object Button1: TButton
  371 + Left = 10
  372 + Height = 25
  373 + Top = 112
  374 + Width = 119
  375 + Caption = 'Button1'
  376 + OnClick = Button1Click
  377 + TabOrder = 2
  378 + end
  379 + object Button2: TButton
  380 + Left = 10
  381 + Height = 25
  382 + Top = 144
  383 + Width = 119
  384 + Caption = 'Button2'
  385 + TabOrder = 3
  386 + end
  387 + object GBExperiment: TGroupBox
  388 + Left = 159
  389 + Height = 172
  390 + Top = 8
  391 + Width = 178
  392 + AutoSize = True
  393 + Caption = 'Experiment'
  394 + ChildSizing.LeftRightSpacing = 20
  395 + ChildSizing.TopBottomSpacing = 20
  396 + ChildSizing.HorizontalSpacing = 30
  397 + ChildSizing.VerticalSpacing = 10
  398 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
  399 + ChildSizing.Layout = cclLeftToRightThenTopToBottom
  400 + ChildSizing.ControlsPerLine = 2
  401 + ClientHeight = 155
  402 + ClientWidth = 174
  403 + TabOrder = 4
  404 + object LabelExpCond: TLabel
  405 + Left = 20
  406 + Height = 15
  407 + Top = 20
  408 + Width = 88
  409 + AutoSize = False
  410 + Caption = 'Condição:'
  411 + ParentColor = False
  412 + end
  413 + object LabelExpCondCount: TLabel
  414 + Left = 138
  415 + Height = 15
  416 + Top = 20
  417 + Width = 16
  418 + AutoSize = False
  419 + Caption = 'NA'
  420 + ParentColor = False
  421 + end
  422 + object LabelExpGen: TLabel
  423 + Left = 20
  424 + Height = 15
  425 + Top = 45
  426 + Width = 88
  427 + Caption = 'Generation:'
  428 + ParentColor = False
  429 + end
  430 + object LabelExpGenCount: TLabel
  431 + Left = 138
  432 + Height = 15
  433 + Top = 45
  434 + Width = 16
  435 + Caption = 'NA'
  436 + ParentColor = False
  437 + end
  438 + object LabelExpCycle: TLabel
  439 + Left = 20
  440 + Height = 15
  441 + Top = 70
  442 + Width = 88
  443 + Caption = 'Cycle:'
  444 + ParentColor = False
  445 + end
  446 + object LabelExpCycleCount: TLabel
  447 + Left = 138
  448 + Height = 15
  449 + Top = 70
  450 + Width = 16
  451 + Caption = 'NA'
  452 + ParentColor = False
  453 + end
  454 + object LabelExpNxtPlayer: TLabel
  455 + Left = 20
  456 + Height = 15
  457 + Top = 95
  458 + Width = 88
  459 + Caption = 'Prox. Jog.:'
  460 + ParentColor = False
  461 + end
  462 + object LabelExpNxtPlayerCount: TLabel
  463 + Left = 138
  464 + Height = 15
  465 + Top = 95
  466 + Width = 16
  467 + Caption = 'NA'
  468 + ParentColor = False
  469 + end
  470 + object Label21: TLabel
  471 + Left = 20
  472 + Height = 15
  473 + Top = 120
  474 + Width = 88
  475 + Caption = 'NA'
  476 + ParentColor = False
  477 + end
  478 + object Label22: TLabel
  479 + Left = 138
  480 + Height = 15
  481 + Top = 120
  482 + Width = 16
  483 + Caption = 'NA'
  484 + ParentColor = False
  485 + end
  486 + end
  487 + end
  488 + object btnConfirmRow: TButton
  489 + Left = 712
  490 + Height = 25
  491 + Top = 320
  492 + Width = 83
  493 + Caption = 'Confirmar'
  494 + OnClick = btnConfirmRowClick
  495 + TabOrder = 5
  496 + Visible = False
  497 + end
  498 + object Button3: TButton
  499 + Left = 632
  500 + Height = 25
  501 + Top = 384
  502 + Width = 75
  503 + Caption = 'Button3'
  504 + OnClick = Button3Click
  505 + TabOrder = 6
  506 + end
  507 +end
form_matrixgame.pas 0 → 100644
  Diff comments   View file @8dc84f5
@@ -0,0 +1,408 @@ @@ -0,0 +1,408 @@
  1 +{
  2 + Stimulus Control
  3 + Copyright (C) 2014-2016 Carlos Rafael Fernandes Picanço, Universidade Federal do Pará.
  4 +
  5 + The present file is distributed under the terms of the GNU General Public License (GPL v3.0).
  6 +
  7 + You should have received a copy of the GNU General Public License
  8 + along with this program. If not, see <http://www.gnu.org/licenses/>.
  9 +}
  10 +unit form_matrixgame;
  11 +
  12 +{$mode objfpc}{$H+}
  13 +
  14 +interface
  15 +
  16 +uses
  17 + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids,
  18 + StdCtrls, DBGrids, ExtCtrls
  19 +
  20 + //, zmq_pub_sub
  21 + , game_zmq_actors
  22 + ;
  23 +
  24 +type
  25 +
  26 + { TFormMatrixGame }
  27 +
  28 + TGameActor = ( gaNone, gaAdmin, gaPlayer, gaWatcher );
  29 +
  30 + TFormMatrixGame = class(TForm)
  31 + btnConfirmRow: TButton;
  32 + Button1: TButton;
  33 + Button2: TButton;
  34 + Button3: TButton;
  35 + CheckBoxDrawDots: TCheckBox;
  36 + GBLastChoice: TGroupBox;
  37 + GBIndividualPoints: TGroupBox;
  38 + GBGrupo: TGroupBox;
  39 + GBAdmin: TGroupBox;
  40 + GBLastChoiceP0: TGroupBox;
  41 + GBLastChoiceP1: TGroupBox;
  42 + GBLastChoiceP2: TGroupBox;
  43 + GBExperiment: TGroupBox;
  44 + Label10: TLabel;
  45 + Label11: TLabel;
  46 + Label12: TLabel;
  47 + Label13: TLabel;
  48 + LabelExpCondCount: TLabel;
  49 + LabelExpGen: TLabel;
  50 + LabelExpGenCount: TLabel;
  51 + LabelExpCycle: TLabel;
  52 + LabelExpCycleCount: TLabel;
  53 + LabelExpNxtPlayer: TLabel;
  54 + LabelExpNxtPlayerCount: TLabel;
  55 + Label21: TLabel;
  56 + Label22: TLabel;
  57 + LabelIndACount: TLabel;
  58 + LabelIndBCount: TLabel;
  59 + LabelCurrentColor1: TLabel;
  60 + LabelCurrentLine1: TLabel;
  61 + LabelIndA: TLabel;
  62 + LabelGroupCount: TLabel;
  63 + LabelIndB: TLabel;
  64 + LabelCurrentLineNumber1: TLabel;
  65 + LabelYouLastChoiceColor3: TLabel;
  66 + LabelYouLastChoiceColor4: TLabel;
  67 + LabelExpCond: TLabel;
  68 + Panel4: TPanel;
  69 + Panel5: TPanel;
  70 + PanelCurrentColor1: TPanel;
  71 + rgMatrixType: TRadioGroup;
  72 + StringGridMatrix: TStringGrid;
  73 + procedure btnConfirmRowClick(Sender: TObject);
  74 + procedure Button1Click(Sender: TObject);
  75 + procedure Button3Click(Sender: TObject);
  76 + procedure CheckBoxDrawDotsChange(Sender: TObject);
  77 + procedure FormActivate(Sender: TObject);
  78 + procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
  79 + procedure FormCreate(Sender: TObject);
  80 + procedure rgMatrixTypeClick(Sender: TObject);
  81 + procedure StringGridMatrixBeforeSelection(Sender: TObject; aCol, aRow: integer);
  82 + procedure StringGridMatrixDrawCell(Sender: TObject; aCol, aRow: integer;
  83 + aRect: TRect; aState: TGridDrawState);
  84 + private
  85 + //FZMQAdmin : TZMQAdmin;
  86 + FZMQActor : TZMQActor;
  87 + FGameActor : TGameActor;
  88 + //FGameActors : TGameActors;
  89 + function GetSelectedRowF(AStringGrid : TStringGrid) : UTF8string;
  90 + function GetRowColor(ARow : integer) : TColor;
  91 + procedure SetGameActor(AValue: TGameActor);
  92 + procedure MessageReceived(AMessage : TStringList);
  93 + public
  94 + property GameActor : TGameActor read FGameActor write SetGameActor;
  95 + end;
  96 +
  97 +var
  98 + FormMatrixGame: TFormMatrixGame;
  99 +
  100 +const
  101 + // row colors
  102 + ccYellow = $00FFFF;
  103 + ccRed = $FF0018;
  104 + ccGreen = $006400;
  105 + ccBlue = $0000FF;
  106 + ccMagenta = $8B008B;
  107 +
  108 +implementation
  109 +
  110 +// uses datamodule;
  111 +var
  112 + RowBase: integer = 0;
  113 + MustDrawSelection : Boolean; // work around until a bug fix for ClearSelection is released
  114 +
  115 +{$R *.lfm}
  116 +
  117 +{ TFormMatrixGame }
  118 +
  119 +procedure TFormMatrixGame.StringGridMatrixDrawCell(Sender: TObject; aCol, aRow: integer;
  120 + aRect: TRect; aState: TGridDrawState);
  121 +var
  122 + OldCanvas: TCanvas;
  123 +
  124 + procedure SaveOldCanvas;
  125 + begin
  126 + OldCanvas := TCanvas.Create;
  127 + OldCanvas.Brush.Style := TStringGrid(Sender).Canvas.Brush.Style;
  128 + OldCanvas.Brush.Color := TStringGrid(Sender).Canvas.Brush.Color;
  129 + OldCanvas.Pen.Width := TStringGrid(Sender).Canvas.Pen.Width;
  130 + OldCanvas.Pen.Color := TStringGrid(Sender).Canvas.Pen.Color;
  131 + OldCanvas.Pen.Mode := TStringGrid(Sender).Canvas.Pen.Mode;
  132 + end;
  133 +
  134 + procedure LoadOldCanvas;
  135 + begin
  136 + TStringGrid(Sender).Canvas.Brush.Style := OldCanvas.Brush.Style;
  137 + TStringGrid(Sender).Canvas.Brush.Color := OldCanvas.Brush.Color;
  138 + TStringGrid(Sender).Canvas.Pen.Width := OldCanvas.Pen.Width;
  139 + TStringGrid(Sender).Canvas.Pen.Color := OldCanvas.Pen.Color;
  140 + TStringGrid(Sender).Canvas.Pen.Mode := OldCanvas.Pen.Mode;
  141 + end;
  142 +
  143 + procedure DrawLines(Color: TColor);
  144 + //function HalfDarker(Color : TColor) : TColor;
  145 + //begin
  146 + // Result := ((Blue(Color) and $7F) shl 16) or ((Green(Color) and $7F) shl 8 ) or (Red(Color) and $7F)
  147 + //end;
  148 +
  149 + procedure DrawDots;
  150 + var
  151 + LFix, LLeft, LRight, LHSize, LVSize: longint;
  152 + begin
  153 + LFix := 2;
  154 + LVSize := ((aRect.Bottom - aRect.Top) div 2);
  155 + LHSize := aRect.Left + (aRect.Right - aRect.Left) div 2;
  156 + LLeft := LHSize - LVSize;
  157 + LRight := LHSize + LVSize;
  158 + TStringGrid(Sender).Canvas.Brush.Style := bsClear;
  159 + TStringGrid(Sender).Canvas.Brush.Color := clBlack;
  160 + TStringGrid(Sender).Canvas.Pen.Color := clBlack;
  161 + TStringGrid(Sender).Canvas.Ellipse(LLeft + LFix, aRect.Top + LFix,
  162 + LRight - LFix, aRect.Bottom - LFix);
  163 + end;
  164 +
  165 + begin
  166 + TStringGrid(Sender).Canvas.Brush.Style := bsSolid;
  167 + TStringGrid(Sender).Canvas.Pen.Width := 1;
  168 + TStringGrid(Sender).Canvas.Brush.Color := Color;
  169 + TStringGrid(Sender).Canvas.Pen.Color := Color;
  170 + TStringGrid(Sender).Canvas.Rectangle(aRect);
  171 + if CheckBoxDrawDots.Checked then
  172 + if (Odd(aRow + RowBase) and not Odd(aCol)) or
  173 + (not Odd(aRow + RowBase) and Odd(aCol)) then
  174 + DrawDots;
  175 + end;
  176 + //function GetTextX(S : String): Longint;
  177 + //begin
  178 + // Result := aRect.Left+((aRect.Right-aRect.Left)div 2) - ((Length(S)*7)div 2);
  179 + //end;
  180 +
  181 +begin
  182 + SaveOldCanvas;
  183 + try
  184 + //if (aRow >= RowBase) and (aCol = 10) then
  185 + // DrawLines(clWhite);
  186 +
  187 + if (aCol <> 0) and (aRow > (RowBase-1)) then
  188 + begin
  189 + DrawLines(GetRowColor(aRow));
  190 +
  191 + if (gdSelected in aState) and MustDrawSelection then
  192 + begin
  193 + TStringGrid(Sender).Canvas.Pen.Width := 10;
  194 + TStringGrid(Sender).Canvas.Pen.Color := clWhite;
  195 + if (aRow = TStringGrid(Sender).Selection.Top) and (aCol = TStringGrid(Sender).Selection.Left) then
  196 + begin
  197 + TStringGrid(Sender).Canvas.PenPos := aRect.TopLeft;
  198 + TStringGrid(Sender).Canvas.LineTo(Point(aRect.Left,aRect.Bottom));
  199 + end;
  200 + TStringGrid(Sender).Canvas.PenPos := aRect.BottomRight;
  201 + TStringGrid(Sender).Canvas.LineTo(Point(aRect.Left,aRect.Bottom));
  202 + TStringGrid(Sender).Canvas.PenPos := aRect.TopLeft;
  203 + TStringGrid(Sender).Canvas.LineTo(Point(aRect.Right,aRect.Top));
  204 +
  205 + if (aRow = TStringGrid(Sender).Selection.Top) and (aCol = TStringGrid(Sender).Selection.Right) then
  206 + begin
  207 + TStringGrid(Sender).Canvas.PenPos := aRect.BottomRight;
  208 + TStringGrid(Sender).Canvas.LineTo(Point(aRect.Right,aRect.Top));
  209 + end;
  210 + end;
  211 + end;
  212 +
  213 + TStringGrid(Sender).Canvas.Pen.Width := 2;
  214 + TStringGrid(Sender).Canvas.Font.Size := 10;
  215 + TStringGrid(Sender).Canvas.Font.Color := clBlack;
  216 + TStringGrid(Sender).Canvas.Brush.Style := bsClear;
  217 +
  218 + if (aCol = 10) and (gdSelected in aState) and MustDrawSelection then
  219 + if (aRow = TStringGrid(Sender).Selection.Top) and (aCol = TStringGrid(Sender).Selection.Right) then
  220 + begin
  221 + btnConfirmRow.Top := aRect.Top+5;
  222 + btnConfirmRow.Left := aRect.Right+5;
  223 + end;
  224 +
  225 + finally
  226 + LoadOldCanvas;
  227 + OldCanvas.Free;
  228 + end;
  229 +end;
  230 +
  231 +function TFormMatrixGame.GetSelectedRowF(AStringGrid: TStringGrid): UTF8string;
  232 +begin
  233 + Result := IntToStr(AStringGrid.Selection.Top);
  234 +end;
  235 +
  236 +function TFormMatrixGame.GetRowColor(ARow: integer): TColor;
  237 +var LRow : integer;
  238 +begin
  239 + if RowBase = 1 then
  240 + LRow := aRow -1
  241 + else LRow := aRow;
  242 +
  243 + case LRow of
  244 + 0,5 :Result := ccYellow;
  245 + 1,6 :Result := ccGreen;
  246 + 2,7 :Result := ccRed;
  247 + 3,8 :Result := ccBlue;
  248 + 4,9 :Result := ccMagenta;
  249 + end;
  250 +end;
  251 +
  252 +procedure TFormMatrixGame.SetGameActor(AValue: TGameActor);
  253 +
  254 + procedure SetZMQAdmin;
  255 + begin
  256 + FZMQActor := TZMQAdmin.Create;
  257 + GBAdmin.Visible:= True;
  258 + end;
  259 +
  260 + procedure SetZMQPlayer;
  261 + begin
  262 + FZMQActor := TZMQPlayer.Create;
  263 + btnConfirmRow.Visible := True;
  264 + StringGridMatrix.Enabled := True
  265 + end;
  266 +
  267 + procedure SetZMQWatcher;
  268 + begin
  269 + FZMQActor := TZMQWatcher.Create;
  270 + end;
  271 +
  272 +begin
  273 + if FGameActor=AValue then Exit;
  274 + FGameActor:=AValue;
  275 +
  276 + case FGameActor of
  277 + gaAdmin: SetZMQAdmin;
  278 + gaPlayer: SetZMQPlayer;
  279 + gaWatcher: SetZMQWatcher;
  280 + end;
  281 +
  282 + FZMQActor.OnMessageReceived:=@MessageReceived;
  283 + FZMQActor.Start;
  284 +end;
  285 +
  286 +procedure TFormMatrixGame.MessageReceived(AMessage: TStringList);
  287 +
  288 + procedure PlayerArrived(AMessage: TStringList);
  289 + begin
  290 + WriteLn('arrived');
  291 + end;
  292 +
  293 + procedure PlayerLogin(AMessage : TStringList);
  294 + begin
  295 + WriteLn('login');
  296 + end;
  297 +
  298 + procedure PlayerLogout(AMessage : TStringList);
  299 + begin
  300 + WriteLn('logout');
  301 + end;
  302 +begin
  303 + case AMessage[0] of
  304 + 'Player.Arrived' : PlayerArrived(AMessage);
  305 + 'Player.Login' : PlayerLogin(AMessage);
  306 + 'Player.Logout': PlayerLogout(AMessage);
  307 + end;
  308 +end;
  309 +
  310 +
  311 +procedure TFormMatrixGame.CheckBoxDrawDotsChange(Sender: TObject);
  312 +begin
  313 + StringGridMatrix.Invalidate;
  314 +end;
  315 +
  316 +procedure TFormMatrixGame.FormActivate(Sender: TObject);
  317 +begin
  318 + StringGridMatrix.ClearSelections;
  319 + StringGridMatrix.FocusRectVisible := False;
  320 +end;
  321 +
  322 +procedure TFormMatrixGame.FormClose(Sender: TObject;
  323 + var CloseAction: TCloseAction);
  324 +begin
  325 + FZMQActor.Free;
  326 +end;
  327 +
  328 +procedure TFormMatrixGame.FormCreate(Sender: TObject);
  329 +begin
  330 + GameActor := gaNone;
  331 +end;
  332 +
  333 +procedure TFormMatrixGame.rgMatrixTypeClick(Sender: TObject);
  334 +
  335 + procedure WriteGridFixedNames(AStringGrid: TStringGrid; WriteCols: boolean);
  336 + var
  337 + i: integer;
  338 + begin
  339 + with AStringGrid do
  340 + for i := 0 to 9 do
  341 + begin
  342 + Cells[0, i + RowBase] := IntToStr(i + 1);
  343 + if WriteCols then
  344 + Cells[i + 1, 0] := chr(65 + i);
  345 + end;
  346 + end;
  347 +
  348 +begin
  349 + case rgMatrixType.ItemIndex of
  350 + // rows only
  351 + 0:
  352 + begin
  353 + StringGridMatrix.Clean;
  354 + StringGridMatrix.FixedRows := 0;
  355 + StringGridMatrix.RowCount := 10;
  356 + StringGridMatrix.Height:=305;
  357 + StringGridMatrix.Options := [goFixedHorzLine, goHorzLine, goDrawFocusSelected, goRowSelect];
  358 + RowBase := 0;
  359 + WriteGridFixedNames(StringGridMatrix, False);
  360 + end;
  361 + // rows and cols
  362 + 1:
  363 + begin
  364 + StringGridMatrix.Clean;
  365 + StringGridMatrix.FixedRows := 1;
  366 + StringGridMatrix.RowCount := 11;
  367 + StringGridMatrix.Height:=335;
  368 + StringGridMatrix.Options := [goFixedHorzLine, goHorzLine, goDrawFocusSelected, goRowSelect, goVertLine];
  369 + RowBase := 1;
  370 + WriteGridFixedNames(StringGridMatrix, True);
  371 + end;
  372 + end;
  373 +
  374 +end;
  375 +
  376 +procedure TFormMatrixGame.StringGridMatrixBeforeSelection(Sender: TObject; aCol, aRow: integer);
  377 +begin
  378 + if MustDrawSelection then Exit;
  379 + MustDrawSelection := True;
  380 +end;
  381 +
  382 +procedure TFormMatrixGame.Button1Click(Sender: TObject);
  383 +begin
  384 +
  385 +end;
  386 +
  387 +procedure TFormMatrixGame.Button3Click(Sender: TObject);
  388 +begin
  389 + //S := TStringList.Create;
  390 + //S.Add('Player.Arrived');
  391 + //S.Add(TZMQAdmin(FZMQActor).ID);
  392 + TZMQAdmin(FZMQActor).SendMessage(['Player.Arrived', TZMQAdmin(FZMQActor).ID]);
  393 + //S.Free;
  394 +end;
  395 +
  396 +procedure TFormMatrixGame.btnConfirmRowClick(Sender: TObject);
  397 +begin
  398 + if FZMQActor.ClassType = TZMQPlayer then
  399 + begin
  400 + //StringGridMatrix.ClearSelections;
  401 + //MustDrawSelection := False;
  402 + StringGridMatrix.Enabled:= False;
  403 + btnConfirmRow.Visible:=False;
  404 + TZMQPlayer(FZMQActor).SendMessage(['Player.ChosenRow', TZMQPlayer(FZMQActor).ID, GetSelectedRowF(StringGridMatrix)]);
  405 + end;
  406 +end;
  407 +
  408 +end.
form_participant.lfm
View file @feb220c
@@ -1,543 +0,0 @@ @@ -1,543 +0,0 @@
1 -object Form1: TForm1  
2 - Left = 109  
3 - Height = 600  
4 - Top = 138  
5 - Width = 1095  
6 - Caption = 'Form1'  
7 - ClientHeight = 600  
8 - ClientWidth = 1095  
9 - Font.Name = 'Monospace'  
10 - LCLVersion = '1.6.0.4'  
11 - object StringGridMatrix: TStringGrid  
12 - AnchorSideLeft.Control = Owner  
13 - AnchorSideTop.Control = Owner  
14 - AnchorSideRight.Control = Owner  
15 - AnchorSideRight.Side = asrBottom  
16 - AnchorSideBottom.Control = Owner  
17 - AnchorSideBottom.Side = asrBottom  
18 - Left = 0  
19 - Height = 344  
20 - Top = 0  
21 - Width = 715  
22 - AutoEdit = False  
23 - BorderSpacing.Right = 150  
24 - BorderSpacing.Bottom = 197  
25 - ColCount = 11  
26 - DefaultRowHeight = 30  
27 - FixedRows = 0  
28 - Flat = True  
29 - Options = [goFixedHorzLine, goHorzLine, goDrawFocusSelected, goRowSelect, goSmoothScroll]  
30 - RowCount = 10  
31 - TabOrder = 0  
32 - TitleFont.Name = 'Monospace'  
33 - OnBeforeSelection = StringGridMatrixBeforeSelection  
34 - OnDrawCell = StringGridMatrixDrawCell  
35 - end  
36 - object CheckBoxDrawDots: TCheckBox  
37 - Left = 728  
38 - Height = 21  
39 - Top = 248  
40 - Width = 87  
41 - Caption = 'DrawDots'  
42 - OnChange = CheckBoxDrawDotsChange  
43 - TabOrder = 1  
44 - end  
45 - object Button1: TButton  
46 - Left = 728  
47 - Height = 25  
48 - Top = 216  
49 - Width = 75  
50 - Caption = 'Button1'  
51 - OnClick = Button1Click  
52 - TabOrder = 2  
53 - end  
54 - object GBIndividualPoints: TGroupBox  
55 - Left = 720  
56 - Height = 122  
57 - Top = 0  
58 - Width = 170  
59 - AutoSize = True  
60 - Caption = 'Pontuação Individual'  
61 - ChildSizing.LeftRightSpacing = 10  
62 - ChildSizing.TopBottomSpacing = 30  
63 - ChildSizing.HorizontalSpacing = 20  
64 - ChildSizing.VerticalSpacing = 15  
65 - ChildSizing.EnlargeHorizontal = crsHomogenousChildResize  
66 - ChildSizing.Layout = cclLeftToRightThenTopToBottom  
67 - ChildSizing.ControlsPerLine = 2  
68 - ClientHeight = 105  
69 - ClientWidth = 166  
70 - TabOrder = 3  
71 - object LabelIndA: TLabel  
72 - Left = 10  
73 - Height = 15  
74 - Top = 30  
75 - Width = 63  
76 - Alignment = taCenter  
77 - AutoSize = False  
78 - Caption = 'A'  
79 - Color = clTeal  
80 - Font.Color = clBlack  
81 - Font.Name = 'Monospace'  
82 - Font.Style = [fsBold]  
83 - ParentColor = False  
84 - ParentFont = False  
85 - Transparent = False  
86 - end  
87 - object LabelIndB: TLabel  
88 - Left = 93  
89 - Height = 15  
90 - Top = 30  
91 - Width = 63  
92 - Alignment = taCenter  
93 - AutoSize = False  
94 - Caption = 'B'  
95 - Color = clTeal  
96 - Font.Color = clBlack  
97 - Font.Name = 'Monospace'  
98 - Font.Style = [fsBold]  
99 - ParentColor = False  
100 - ParentFont = False  
101 - Transparent = False  
102 - end  
103 - object LabelIndACount: TLabel  
104 - Left = 10  
105 - Height = 15  
106 - Top = 60  
107 - Width = 63  
108 - Alignment = taCenter  
109 - AutoSize = False  
110 - Caption = '0'  
111 - Color = clDefault  
112 - ParentColor = False  
113 - Transparent = False  
114 - end  
115 - object LabelIndBCount: TLabel  
116 - Left = 93  
117 - Height = 15  
118 - Top = 60  
119 - Width = 63  
120 - Alignment = taCenter  
121 - AutoSize = False  
122 - Caption = '0'  
123 - Color = clDefault  
124 - ParentColor = False  
125 - Transparent = False  
126 - end  
127 - end  
128 - object GBGrupo: TGroupBox  
129 - Left = 896  
130 - Height = 122  
131 - Top = 0  
132 - Width = 170  
133 - AutoSize = True  
134 - Caption = ' Pontuação do Grupo '  
135 - ChildSizing.LeftRightSpacing = 35  
136 - ChildSizing.TopBottomSpacing = 45  
137 - ChildSizing.Layout = cclLeftToRightThenTopToBottom  
138 - ChildSizing.ControlsPerLine = 1  
139 - ClientHeight = 105  
140 - ClientWidth = 166  
141 - TabOrder = 4  
142 - object LabelGroupCount: TLabel  
143 - Left = 35  
144 - Height = 15  
145 - Top = 45  
146 - Width = 96  
147 - Align = alClient  
148 - Alignment = taCenter  
149 - AutoSize = False  
150 - Caption = '0'  
151 - Color = clDefault  
152 - Layout = tlCenter  
153 - ParentColor = False  
154 - Transparent = False  
155 - end  
156 - end  
157 - object GBChoicesLastTurn: TGroupBox  
158 - AnchorSideLeft.Control = Owner  
159 - AnchorSideRight.Control = Owner  
160 - AnchorSideRight.Side = asrBottom  
161 - AnchorSideBottom.Control = Owner  
162 - AnchorSideBottom.Side = asrBottom  
163 - Left = 0  
164 - Height = 124  
165 - Top = 476  
166 - Width = 1095  
167 - Anchors = [akLeft, akRight, akBottom]  
168 - AutoSize = True  
169 - Caption = 'Escolhas na jogada passada'  
170 - ChildSizing.LeftRightSpacing = 10  
171 - ChildSizing.TopBottomSpacing = 5  
172 - ChildSizing.HorizontalSpacing = 10  
173 - ChildSizing.ControlsPerLine = 6  
174 - ClientHeight = 107  
175 - ClientWidth = 1091  
176 - TabOrder = 5  
177 - object IndLastResponse: TGroupBox  
178 - Left = 10  
179 - Height = 97  
180 - Top = 5  
181 - Width = 138  
182 - AutoSize = True  
183 - Caption = 'Você'  
184 - ChildSizing.LeftRightSpacing = 20  
185 - ChildSizing.TopBottomSpacing = 20  
186 - ChildSizing.HorizontalSpacing = 30  
187 - ChildSizing.VerticalSpacing = 10  
188 - ChildSizing.EnlargeHorizontal = crsHomogenousChildResize  
189 - ChildSizing.Layout = cclLeftToRightThenTopToBottom  
190 - ChildSizing.ControlsPerLine = 2  
191 - ClientHeight = 80  
192 - ClientWidth = 134  
193 - TabOrder = 0  
194 - object LabelLastColor: TLabel  
195 - Left = 20  
196 - Height = 15  
197 - Top = 20  
198 - Width = 48  
199 - AutoSize = False  
200 - Caption = 'Cor:'  
201 - ParentColor = False  
202 - end  
203 - object PanelLastColor: TPanel  
204 - Left = 98  
205 - Height = 15  
206 - Top = 20  
207 - Width = 16  
208 - Color = clBlack  
209 - ParentColor = False  
210 - TabOrder = 0  
211 - end  
212 - object LabelLastLine: TLabel  
213 - Left = 20  
214 - Height = 15  
215 - Top = 45  
216 - Width = 48  
217 - AutoSize = False  
218 - Caption = 'Linha:'  
219 - ParentColor = False  
220 - end  
221 - object LabelLastLineNumber: TLabel  
222 - Left = 98  
223 - Height = 15  
224 - Top = 45  
225 - Width = 16  
226 - Caption = 'NA'  
227 - ParentColor = False  
228 - end  
229 - end  
230 - object IndLastResponse1: TGroupBox  
231 - Left = 170  
232 - Height = 97  
233 - Top = 5  
234 - Width = 138  
235 - AutoSize = True  
236 - Caption = 'João'  
237 - ChildSizing.LeftRightSpacing = 20  
238 - ChildSizing.TopBottomSpacing = 20  
239 - ChildSizing.HorizontalSpacing = 30  
240 - ChildSizing.VerticalSpacing = 10  
241 - ChildSizing.EnlargeHorizontal = crsHomogenousChildResize  
242 - ChildSizing.Layout = cclLeftToRightThenTopToBottom  
243 - ChildSizing.ControlsPerLine = 2  
244 - ClientHeight = 80  
245 - ClientWidth = 134  
246 - TabOrder = 1  
247 - object LabelYouLastChoiceColor1: TLabel  
248 - Left = 20  
249 - Height = 15  
250 - Top = 20  
251 - Width = 48  
252 - AutoSize = False  
253 - Caption = 'Cor:'  
254 - ParentColor = False  
255 - end  
256 - object Panel2: TPanel  
257 - Left = 98  
258 - Height = 15  
259 - Top = 20  
260 - Width = 16  
261 - Color = clBlack  
262 - ParentColor = False  
263 - TabOrder = 0  
264 - end  
265 - object Label6: TLabel  
266 - Left = 20  
267 - Height = 15  
268 - Top = 45  
269 - Width = 48  
270 - AutoSize = False  
271 - Caption = 'Linha:'  
272 - ParentColor = False  
273 - end  
274 - object Label7: TLabel  
275 - Left = 98  
276 - Height = 15  
277 - Top = 45  
278 - Width = 16  
279 - Caption = 'NA'  
280 - ParentColor = False  
281 - end  
282 - end  
283 - object IndLastResponse2: TGroupBox  
284 - Left = 322  
285 - Height = 97  
286 - Top = 5  
287 - Width = 138  
288 - AutoSize = True  
289 - Caption = 'Maria'  
290 - ChildSizing.LeftRightSpacing = 20  
291 - ChildSizing.TopBottomSpacing = 20  
292 - ChildSizing.HorizontalSpacing = 30  
293 - ChildSizing.VerticalSpacing = 10  
294 - ChildSizing.EnlargeHorizontal = crsHomogenousChildResize  
295 - ChildSizing.Layout = cclLeftToRightThenTopToBottom  
296 - ChildSizing.ControlsPerLine = 2  
297 - ClientHeight = 80  
298 - ClientWidth = 134  
299 - TabOrder = 2  
300 - object LabelYouLastChoiceColor2: TLabel  
301 - Left = 20  
302 - Height = 15  
303 - Top = 20  
304 - Width = 48  
305 - AutoSize = False  
306 - Caption = 'Cor:'  
307 - ParentColor = False  
308 - end  
309 - object Panel3: TPanel  
310 - Left = 98  
311 - Height = 15  
312 - Top = 20  
313 - Width = 16  
314 - Color = clBlack  
315 - ParentColor = False  
316 - TabOrder = 0  
317 - end  
318 - object Label8: TLabel  
319 - Left = 20  
320 - Height = 15  
321 - Top = 45  
322 - Width = 48  
323 - AutoSize = False  
324 - Caption = 'Linha:'  
325 - ParentColor = False  
326 - end  
327 - object Label9: TLabel  
328 - Left = 98  
329 - Height = 15  
330 - Top = 45  
331 - Width = 16  
332 - Caption = 'NA'  
333 - ParentColor = False  
334 - end  
335 - end  
336 - end  
337 - object rgMatrixType: TRadioGroup  
338 - Left = 728  
339 - Height = 59  
340 - Top = 272  
341 - Width = 119  
342 - AutoFill = True  
343 - AutoSize = True  
344 - Caption = 'MatrixType'  
345 - ChildSizing.LeftRightSpacing = 6  
346 - ChildSizing.EnlargeHorizontal = crsHomogenousChildResize  
347 - ChildSizing.EnlargeVertical = crsHomogenousChildResize  
348 - ChildSizing.ShrinkHorizontal = crsScaleChilds  
349 - ChildSizing.ShrinkVertical = crsScaleChilds  
350 - ChildSizing.Layout = cclLeftToRightThenTopToBottom  
351 - ChildSizing.ControlsPerLine = 1  
352 - ClientHeight = 42  
353 - ClientWidth = 115  
354 - ItemIndex = 0  
355 - Items.Strings = (  
356 - 'Rows'  
357 - 'Rows & Cols'  
358 - )  
359 - OnClick = rgMatrixTypeClick  
360 - TabOrder = 6  
361 - end  
362 - object GBChoicesCurrentTurn: TGroupBox  
363 - AnchorSideLeft.Control = Owner  
364 - AnchorSideRight.Control = Owner  
365 - AnchorSideRight.Side = asrBottom  
366 - AnchorSideBottom.Control = Owner  
367 - AnchorSideBottom.Side = asrBottom  
368 - Left = 0  
369 - Height = 124  
370 - Top = 349  
371 - Width = 1095  
372 - Anchors = [akLeft, akRight, akBottom]  
373 - AutoSize = True  
374 - BorderSpacing.Bottom = 127  
375 - Caption = 'Escolhas nesta jogada'  
376 - ChildSizing.LeftRightSpacing = 10  
377 - ChildSizing.TopBottomSpacing = 5  
378 - ChildSizing.HorizontalSpacing = 10  
379 - ChildSizing.ControlsPerLine = 6  
380 - ClientHeight = 107  
381 - ClientWidth = 1091  
382 - TabOrder = 7  
383 - object IndCurrentResponse1: TGroupBox  
384 - Left = 10  
385 - Height = 97  
386 - Top = 5  
387 - Width = 138  
388 - AutoSize = True  
389 - Caption = 'Você'  
390 - ChildSizing.LeftRightSpacing = 20  
391 - ChildSizing.TopBottomSpacing = 20  
392 - ChildSizing.HorizontalSpacing = 30  
393 - ChildSizing.VerticalSpacing = 10  
394 - ChildSizing.EnlargeHorizontal = crsHomogenousChildResize  
395 - ChildSizing.Layout = cclLeftToRightThenTopToBottom  
396 - ChildSizing.ControlsPerLine = 2  
397 - ClientHeight = 80  
398 - ClientWidth = 134  
399 - TabOrder = 0  
400 - object LabelCurrentColor1: TLabel  
401 - Left = 20  
402 - Height = 15  
403 - Top = 20  
404 - Width = 48  
405 - AutoSize = False  
406 - Caption = 'Cor:'  
407 - ParentColor = False  
408 - end  
409 - object PanelCurrentColor1: TPanel  
410 - Left = 98  
411 - Height = 15  
412 - Top = 20  
413 - Width = 16  
414 - Color = clBlack  
415 - ParentColor = False  
416 - TabOrder = 0  
417 - end  
418 - object LabelCurrentLine1: TLabel  
419 - Left = 20  
420 - Height = 15  
421 - Top = 45  
422 - Width = 48  
423 - AutoSize = False  
424 - Caption = 'Linha:'  
425 - ParentColor = False  
426 - end  
427 - object LabelCurrentLineNumber1: TLabel  
428 - Left = 98  
429 - Height = 15  
430 - Top = 45  
431 - Width = 16  
432 - Caption = 'NA'  
433 - ParentColor = False  
434 - end  
435 - end  
436 - object IndLastResponse4: TGroupBox  
437 - Left = 170  
438 - Height = 97  
439 - Top = 5  
440 - Width = 138  
441 - AutoSize = True  
442 - Caption = 'João'  
443 - ChildSizing.LeftRightSpacing = 20  
444 - ChildSizing.TopBottomSpacing = 20  
445 - ChildSizing.HorizontalSpacing = 30  
446 - ChildSizing.VerticalSpacing = 10  
447 - ChildSizing.EnlargeHorizontal = crsHomogenousChildResize  
448 - ChildSizing.Layout = cclLeftToRightThenTopToBottom  
449 - ChildSizing.ControlsPerLine = 2  
450 - ClientHeight = 80  
451 - ClientWidth = 134  
452 - TabOrder = 1  
453 - object LabelYouLastChoiceColor3: TLabel  
454 - Left = 20  
455 - Height = 15  
456 - Top = 20  
457 - Width = 48  
458 - AutoSize = False  
459 - Caption = 'Cor:'  
460 - ParentColor = False  
461 - end  
462 - object Panel4: TPanel  
463 - Left = 98  
464 - Height = 15  
465 - Top = 20  
466 - Width = 16  
467 - Color = clBlack  
468 - ParentColor = False  
469 - TabOrder = 0  
470 - end  
471 - object Label10: TLabel  
472 - Left = 20  
473 - Height = 15  
474 - Top = 45  
475 - Width = 48  
476 - AutoSize = False  
477 - Caption = 'Linha:'  
478 - ParentColor = False  
479 - end  
480 - object Label11: TLabel  
481 - Left = 98  
482 - Height = 15  
483 - Top = 45  
484 - Width = 16  
485 - Caption = 'NA'  
486 - ParentColor = False  
487 - end  
488 - end  
489 - object IndLastResponse5: TGroupBox  
490 - Left = 322  
491 - Height = 97  
492 - Top = 5  
493 - Width = 138  
494 - AutoSize = True  
495 - Caption = 'Maria'  
496 - ChildSizing.LeftRightSpacing = 20  
497 - ChildSizing.TopBottomSpacing = 20  
498 - ChildSizing.HorizontalSpacing = 30  
499 - ChildSizing.VerticalSpacing = 10  
500 - ChildSizing.EnlargeHorizontal = crsHomogenousChildResize  
501 - ChildSizing.Layout = cclLeftToRightThenTopToBottom  
502 - ChildSizing.ControlsPerLine = 2  
503 - ClientHeight = 80  
504 - ClientWidth = 134  
505 - TabOrder = 2  
506 - object LabelYouLastChoiceColor4: TLabel  
507 - Left = 20  
508 - Height = 15  
509 - Top = 20  
510 - Width = 48  
511 - AutoSize = False  
512 - Caption = 'Cor:'  
513 - ParentColor = False  
514 - end  
515 - object Panel5: TPanel  
516 - Left = 98  
517 - Height = 15  
518 - Top = 20  
519 - Width = 16  
520 - Color = clBlack  
521 - ParentColor = False  
522 - TabOrder = 0  
523 - end  
524 - object Label12: TLabel  
525 - Left = 20  
526 - Height = 15  
527 - Top = 45  
528 - Width = 48  
529 - AutoSize = False  
530 - Caption = 'Linha:'  
531 - ParentColor = False  
532 - end  
533 - object Label13: TLabel  
534 - Left = 98  
535 - Height = 15  
536 - Top = 45  
537 - Width = 16  
538 - Caption = 'NA'  
539 - ParentColor = False  
540 - end  
541 - end  
542 - end  
543 -end  
form_participant.pas
View file @feb220c
@@ -1,258 +0,0 @@ @@ -1,258 +0,0 @@
1 -{  
2 - Stimulus Control  
3 - Copyright (C) 2014-2016 Carlos Rafael Fernandes Picanço, Universidade Federal do Pará.  
4 -  
5 - The present file is distributed under the terms of the GNU General Public License (GPL v3.0).  
6 -  
7 - You should have received a copy of the GNU General Public License  
8 - along with this program. If not, see <http://www.gnu.org/licenses/>.  
9 -}  
10 -unit form_participant;  
11 -  
12 -{$mode objfpc}{$H+}  
13 -  
14 -interface  
15 -  
16 -uses  
17 - Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids,  
18 - StdCtrls, DBGrids, ExtCtrls;  
19 -  
20 -type  
21 -  
22 - { TForm1 }  
23 -  
24 - TForm1 = class(TForm)  
25 - Button1: TButton;  
26 - CheckBoxDrawDots: TCheckBox;  
27 - GBChoicesCurrentTurn: TGroupBox;  
28 - GBIndividualPoints: TGroupBox;  
29 - GBGrupo: TGroupBox;  
30 - GBChoicesLastTurn: TGroupBox;  
31 - IndLastResponse: TGroupBox;  
32 - IndLastResponse1: TGroupBox;  
33 - IndLastResponse2: TGroupBox;  
34 - IndCurrentResponse1: TGroupBox;  
35 - IndLastResponse4: TGroupBox;  
36 - IndLastResponse5: TGroupBox;  
37 - Label10: TLabel;  
38 - Label11: TLabel;  
39 - Label12: TLabel;  
40 - Label13: TLabel;  
41 - LabelIndACount: TLabel;  
42 - LabelIndBCount: TLabel;  
43 - LabelCurrentColor1: TLabel;  
44 - LabelLastLine: TLabel;  
45 - LabelCurrentLine1: TLabel;  
46 - LabelLastLineNumber: TLabel;  
47 - Label6: TLabel;  
48 - Label7: TLabel;  
49 - Label8: TLabel;  
50 - Label9: TLabel;  
51 - LabelIndA: TLabel;  
52 - LabelGroupCount: TLabel;  
53 - LabelIndB: TLabel;  
54 - LabelLastColor: TLabel;  
55 - LabelCurrentLineNumber1: TLabel;  
56 - LabelYouLastChoiceColor1: TLabel;  
57 - LabelYouLastChoiceColor2: TLabel;  
58 - LabelYouLastChoiceColor3: TLabel;  
59 - LabelYouLastChoiceColor4: TLabel;  
60 - Panel4: TPanel;  
61 - Panel5: TPanel;  
62 - PanelLastColor: TPanel;  
63 - Panel2: TPanel;  
64 - Panel3: TPanel;  
65 - PanelCurrentColor1: TPanel;  
66 - rgMatrixType: TRadioGroup;  
67 - StringGridMatrix: TStringGrid;  
68 - procedure Button1Click(Sender: TObject);  
69 - procedure CheckBoxDrawDotsChange(Sender: TObject);  
70 - procedure rgMatrixTypeClick(Sender: TObject);  
71 - procedure StringGridMatrixBeforeSelection(Sender: TObject; aCol, aRow: integer);  
72 - procedure StringGridMatrixDrawCell(Sender: TObject; aCol, aRow: integer;  
73 - aRect: TRect; aState: TGridDrawState);  
74 - private  
75 - { private declarations }  
76 - public  
77 - { public declarations }  
78 - end;  
79 -  
80 -var  
81 - Form1: TForm1;  
82 - RowBase: integer = 0;  
83 - MustDrawSelection : Boolean;  
84 -  
85 -const  
86 - ccYellow = $00FFFF;  
87 - ccRed = $FF0018;  
88 - ccGreen = $006400;  
89 - ccBlue = $0000FF;  
90 - ccMagenta = $8B008B;  
91 -  
92 -implementation  
93 -  
94 -// uses datamodule;  
95 -  
96 -{$R *.lfm}  
97 -  
98 -{ TForm1 }  
99 -  
100 -procedure TForm1.StringGridMatrixDrawCell(Sender: TObject; aCol, aRow: integer;  
101 - aRect: TRect; aState: TGridDrawState);  
102 -var  
103 - OldCanvas: TCanvas;  
104 -  
105 - procedure SaveOldCanvas;  
106 - begin  
107 - OldCanvas.Brush.Style := TStringGrid(Sender).Canvas.Brush.Style;  
108 - OldCanvas.Brush.Color := TStringGrid(Sender).Canvas.Brush.Color;  
109 - OldCanvas.Pen.Width := TStringGrid(Sender).Canvas.Pen.Width;  
110 - OldCanvas.Pen.Color := TStringGrid(Sender).Canvas.Pen.Color;  
111 - OldCanvas.Pen.Mode := TStringGrid(Sender).Canvas.Pen.Mode;  
112 -  
113 - end;  
114 -  
115 - procedure LoadOldCanvas;  
116 - begin  
117 - TStringGrid(Sender).Canvas.Brush.Style := OldCanvas.Brush.Style;  
118 - TStringGrid(Sender).Canvas.Brush.Color := OldCanvas.Brush.Color;  
119 - TStringGrid(Sender).Canvas.Pen.Width := OldCanvas.Pen.Width;  
120 - TStringGrid(Sender).Canvas.Pen.Color := OldCanvas.Pen.Color;  
121 - TStringGrid(Sender).Canvas.Pen.Mode := OldCanvas.Pen.Mode;  
122 - end;  
123 -  
124 - procedure DrawLines(Color: TColor);  
125 - //function HalfDarker(Color : TColor) : TColor;  
126 - //begin  
127 - // Result := ((Blue(Color) and $7F) shl 16) or ((Green(Color) and $7F) shl 8 ) or (Red(Color) and $7F)  
128 - //end;  
129 -  
130 - procedure DrawDots;  
131 - var  
132 - LFix, LLeft, LRight, LHSize, LVSize: longint;  
133 - begin  
134 - LFix := 2;  
135 - LVSize := ((aRect.Bottom - aRect.Top) div 2);  
136 - LHSize := aRect.Left + (aRect.Right - aRect.Left) div 2;  
137 - LLeft := LHSize - LVSize;  
138 - LRight := LHSize + LVSize;  
139 - TStringGrid(Sender).Canvas.Brush.Style := bsClear;  
140 - TStringGrid(Sender).Canvas.Brush.Color := clBlack;  
141 - TStringGrid(Sender).Canvas.Pen.Color := clBlack;  
142 - TStringGrid(Sender).Canvas.Ellipse(LLeft + LFix, aRect.Top + LFix,  
143 - LRight - LFix, aRect.Bottom - LFix);  
144 - end;  
145 -  
146 - begin  
147 - TStringGrid(Sender).Canvas.Brush.Style := bsSolid;  
148 - TStringGrid(Sender).Canvas.Pen.Width := 1;  
149 - TStringGrid(Sender).Canvas.Brush.Color := Color;  
150 - TStringGrid(Sender).Canvas.Pen.Color := Color;  
151 - TStringGrid(Sender).Canvas.Rectangle(aRect);  
152 - if CheckBoxDrawDots.Checked then  
153 - if (Odd(aRow + RowBase) and not Odd(aCol)) or  
154 - (not Odd(aRow + RowBase) and Odd(aCol)) then  
155 - DrawDots;  
156 - end;  
157 -  
158 -begin  
159 - OldCanvas := TCanvas.Create;  
160 - SaveOldCanvas;  
161 - try  
162 - if (aCol <> 0) then  
163 - begin  
164 - if (aRow = RowBase) or (aRow = (RowBase + 5)) then DrawLines(ccYellow);  
165 - if (aRow = RowBase + 1) or (aRow = (RowBase + 6)) then DrawLines(ccGreen);  
166 - if (aRow = RowBase + 2) or (aRow = (RowBase + 7)) then DrawLines(ccRed);  
167 - if (aRow = RowBase + 3) or (aRow = (RowBase + 8)) then DrawLines(ccBlue);  
168 - if (aRow = RowBase + 4) or (aRow = (RowBase + 9)) then DrawLines(ccMagenta);  
169 - end;  
170 -  
171 - if (aCol <> 0) then  
172 - if (gdSelected in aState) and MustDrawSelection then  
173 - begin  
174 - TStringGrid(Sender).Canvas.Pen.Width := 10;  
175 - TStringGrid(Sender).Canvas.Pen.Color := clWhite;  
176 - if (aRow = TStringGrid(Sender).Selection.Top) and (aCol = TStringGrid(Sender).Selection.Left) then  
177 - begin  
178 - TStringGrid(Sender).Canvas.PenPos := aRect.TopLeft;  
179 - TStringGrid(Sender).Canvas.LineTo(Point(aRect.Left,aRect.Bottom));  
180 - end;  
181 - TStringGrid(Sender).Canvas.PenPos := aRect.BottomRight;  
182 - TStringGrid(Sender).Canvas.LineTo(Point(aRect.Left,aRect.Bottom));  
183 - TStringGrid(Sender).Canvas.PenPos := aRect.TopLeft;  
184 - TStringGrid(Sender).Canvas.LineTo(Point(aRect.Right,aRect.Top));  
185 -  
186 - if (aRow = TStringGrid(Sender).Selection.Top) and (aCol = TStringGrid(Sender).Selection.Right) then  
187 - begin  
188 - TStringGrid(Sender).Canvas.PenPos := aRect.BottomRight;  
189 - TStringGrid(Sender).Canvas.LineTo(Point(aRect.Right,aRect.Top));  
190 - end;  
191 - end;  
192 - finally  
193 - LoadOldCanvas;  
194 - OldCanvas.Free;  
195 - end;  
196 -end;  
197 -  
198 -  
199 -procedure TForm1.CheckBoxDrawDotsChange(Sender: TObject);  
200 -begin  
201 - StringGridMatrix.Invalidate;  
202 -end;  
203 -  
204 -procedure TForm1.rgMatrixTypeClick(Sender: TObject);  
205 -  
206 - procedure WriteGridFixedNames(AStringGrid: TStringGrid; WriteCols: boolean);  
207 - var  
208 - i: integer;  
209 - begin  
210 - with AStringGrid do  
211 - for i := 0 to 9 do  
212 - begin  
213 - Cells[0, i + RowBase] := IntToStr(i + 1);  
214 - if WriteCols then  
215 - Cells[i + 1, 0] := chr(65 + i);  
216 - end;  
217 - end;  
218 -  
219 -begin  
220 - case rgMatrixType.ItemIndex of  
221 - // rows only  
222 - 0:  
223 - begin  
224 - StringGridMatrix.Clean;  
225 - StringGridMatrix.FixedRows := 0;  
226 - StringGridMatrix.RowCount := 10;  
227 - StringGridMatrix.Options := [goFixedHorzLine, goHorzLine, goDrawFocusSelected, goRowSelect];  
228 - RowBase := 0;  
229 - WriteGridFixedNames(StringGridMatrix, False);  
230 - end;  
231 - // rows and cols  
232 - 1:  
233 - begin  
234 - StringGridMatrix.Clean;  
235 - StringGridMatrix.FixedRows := 1;  
236 - StringGridMatrix.RowCount := 11;  
237 - StringGridMatrix.Options := [goFixedHorzLine, goHorzLine, goDrawFocusSelected, goRowSelect, goVertLine];  
238 - RowBase := 1;  
239 - WriteGridFixedNames(StringGridMatrix, True);  
240 - end;  
241 - end;  
242 -  
243 -end;  
244 -  
245 -procedure TForm1.StringGridMatrixBeforeSelection(Sender: TObject; aCol, aRow: integer);  
246 -begin  
247 - if MustDrawSelection then Exit;  
248 - MustDrawSelection := True;  
249 -end;  
250 -  
251 -procedure TForm1.Button1Click(Sender: TObject);  
252 -begin  
253 - StringGridMatrix.ClearSelections;  
254 - MustDrawSelection := False;  
255 - StringGridMatrix.Invalidate;  
256 -end;  
257 -  
258 -end.  
units/game_actors.pas 0 → 100644
  Diff comments   View file @8dc84f5
@@ -0,0 +1,59 @@ @@ -0,0 +1,59 @@
  1 +unit game_actors;
  2 +
  3 +{$mode objfpc}{$H+}
  4 +
  5 +interface
  6 +
  7 +uses
  8 + Classes, SysUtils
  9 + , game_zmq_actors
  10 + ;
  11 +type
  12 +
  13 + { TActor }
  14 +
  15 + TActor = class(TComponent)
  16 + private
  17 + FZMQActor : TZMQActor;
  18 + public
  19 + constructor Create(AZMQActor : TZMQActor; AOwner : TComponent);
  20 + procedure SendMessage(AMessage : array of UTF8string);
  21 + end;
  22 +
  23 + TAdmin = record
  24 +
  25 + end;
  26 +
  27 + TChoice = record
  28 + Row : ShortInt;
  29 + Color : integer;
  30 + end;
  31 +
  32 + TPlayer = record
  33 + ID : UTF8string;
  34 + Choice,
  35 + ChoiceLast : TChoice;
  36 + end;
  37 +
  38 + TWatcher = record
  39 +
  40 + end;
  41 +
  42 +
  43 +implementation
  44 +
  45 +{ TActor }
  46 +
  47 +constructor TActor.Create(AZMQActor: TZMQActor; AOwner: TComponent);
  48 +begin
  49 + inherited Create(AOwner);
  50 + FZMQActor := AZMQActor;
  51 +end;
  52 +
  53 +procedure TActor.SendMessage(AMessage: array of UTF8string);
  54 +begin
  55 +
  56 +end;
  57 +
  58 +end.
  59 +
units/game_zmq_actors.pas 0 → 100644
  Diff comments   View file @8dc84f5
@@ -0,0 +1,160 @@ @@ -0,0 +1,160 @@
  1 +unit game_zmq_actors;
  2 +
  3 +{$mode objfpc}{$H+}
  4 +
  5 +interface
  6 +
  7 +uses
  8 + Classes, SysUtils
  9 + , zmq_network
  10 + //, zmq_client
  11 + ;
  12 +
  13 +type
  14 +
  15 + { TZMQActor }
  16 +
  17 + TZMQActor = class(TComponent)
  18 + private
  19 + FSubscriber: TZMQPollThread;
  20 + FOnMessageReceived : TMessRecvProc;
  21 + function GetActorID: UTF8string; virtual;
  22 + protected
  23 + procedure MessageReceived(AMultipartMessage : TStringList);
  24 + public
  25 + constructor Create(AOwner : TComponent); override;
  26 + destructor Destroy; override;
  27 + procedure Start; virtual;
  28 + property OnMessageReceived : TMessRecvProc read FOnMessageReceived write FOnMessageReceived;
  29 + property ID : UTF8string read GetActorID;
  30 + end;
  31 +
  32 + { TZMQPlayer }
  33 +
  34 + TZMQPlayer = class(TZMQActor)
  35 + private
  36 + FPusher : TZMQPusher;
  37 + function GetActorID: UTF8string; override;
  38 + public
  39 + constructor Create(AOwner : TComponent); override;
  40 + destructor Destroy; override;
  41 + procedure Start; override;
  42 + procedure SendMessage(AMessage : array of UTF8string);
  43 + property ID : UTF8string read GetActorID;
  44 + end;
  45 +
  46 + { TZMQAdmin }
  47 +
  48 + TZMQAdmin = class(TZMQPlayer)
  49 + private
  50 + FPublisher : TZMQPubThread;
  51 + public
  52 + constructor Create(AOwner : TComponent); override;
  53 + destructor Destroy; override;
  54 + procedure Start; override;
  55 + end;
  56 +
  57 + { TZMQWatcher }
  58 +
  59 + TZMQWatcher = class(TZMQActor)
  60 + public
  61 + procedure Start; override;
  62 + end;
  63 +
  64 +implementation
  65 +
  66 +{ TZMQWatcher }
  67 +
  68 +procedure TZMQWatcher.Start;
  69 +begin
  70 + AbstractError;
  71 + inherited Start;
  72 + WriteLn('TZMQWatcher.Start');
  73 +end;
  74 +
  75 +{ TZMQAdmin }
  76 +
  77 +constructor TZMQAdmin.Create(AOwner: TComponent);
  78 +begin
  79 + FPublisher := TZMQPubThread.Create;
  80 + inherited Create(AOwner);
  81 +end;
  82 +
  83 +destructor TZMQAdmin.Destroy;
  84 +begin
  85 + FPublisher.Terminate;
  86 + inherited Destroy;
  87 +end;
  88 +
  89 +procedure TZMQAdmin.Start;
  90 +begin
  91 + FPublisher.Start;
  92 + inherited Start;
  93 + WriteLn('TZMQAdmin.Start');
  94 +end;
  95 +
  96 +{ TZMQPlayer }
  97 +
  98 +procedure TZMQPlayer.SendMessage(AMessage: array of UTF8string);
  99 +begin
  100 + FPusher.SendMessage(AMessage);
  101 +end;
  102 +
  103 +function TZMQPlayer.GetActorID: UTF8string;
  104 +begin
  105 + Result := FPusher.ID;
  106 +end;
  107 +
  108 +constructor TZMQPlayer.Create(AOwner: TComponent);
  109 +begin
  110 + inherited Create(AOwner);
  111 + FPusher := TZMQPusher.Create;
  112 +end;
  113 +
  114 +destructor TZMQPlayer.Destroy;
  115 +begin
  116 + FPusher.Free;
  117 + inherited Destroy;
  118 +end;
  119 +
  120 +procedure TZMQPlayer.Start;
  121 +begin
  122 + inherited Start;
  123 + WriteLn('TZMQPlayer.Start');
  124 +end;
  125 +
  126 +{ TZMQActor }
  127 +
  128 +function TZMQActor.GetActorID: UTF8string;
  129 +begin
  130 + AbstractError;
  131 + Result := '';
  132 +end;
  133 +
  134 +procedure TZMQActor.MessageReceived(AMultipartMessage: TStringList);
  135 +begin
  136 + if Assigned(FOnMessageReceived) then FOnMessageReceived(AMultipartMessage);
  137 +end;
  138 +
  139 +constructor TZMQActor.Create(AOwner: TComponent);
  140 +begin
  141 + inherited Create(AOwner);
  142 + FSubscriber := TZMQPollThread.Create;
  143 + FSubscriber.OnMessageReceived:=@MessageReceived;
  144 +end;
  145 +
  146 +destructor TZMQActor.Destroy;
  147 +begin
  148 + OnMessageReceived := nil;
  149 + FSubscriber.Terminate;
  150 + inherited Destroy;
  151 +end;
  152 +
  153 +procedure TZMQActor.Start;
  154 +begin
  155 + FSubscriber.Start;
  156 + WriteLn('TZMQActor.Start');
  157 +end;
  158 +
  159 +end.
  160 +
units/zmq_network.pas 0 → 100644
  Diff comments   View file @8dc84f5
@@ -0,0 +1,208 @@ @@ -0,0 +1,208 @@
  1 +{
  2 + Stimulus Control
  3 + Copyright (C) 2014-2016 Carlos Rafael Fernandes Picanço, Universidade Federal do Pará.
  4 +
  5 + The present file is distributed under the terms of the GNU General Public License (GPL v3.0).
  6 +
  7 + You should have received a copy of the GNU General Public License
  8 + along with this program. If not, see <http://www.gnu.org/licenses/>.
  9 +}
  10 +unit zmq_network;
  11 +
  12 +{$mode objfpc}{$H+}
  13 +
  14 +interface
  15 +
  16 +uses Classes, SysUtils, Process
  17 +
  18 + , zmqapi
  19 + //, zmq_client
  20 + ;
  21 +
  22 +type
  23 +
  24 + { TZMQPusher }
  25 +
  26 + TZMQPusher = class
  27 + private
  28 + FContext : TZMQContext;
  29 + FID: UTF8string;
  30 + FPusher : TZMQSocket;
  31 + public
  32 + constructor Create;
  33 + destructor Destroy; override;
  34 + procedure SendMessage(AMultipartMessage : array of UTF8string);
  35 + property ID : UTF8string read FID;
  36 + end;
  37 +
  38 + { TZMQPubThread }
  39 +
  40 + TZMQPubThread = class(TThread)
  41 + private
  42 + FContext : TZMQContext;
  43 + FPublisher : TZMQSocket;
  44 + FPuller : TZMQSocket;
  45 + protected
  46 + procedure Execute; override;
  47 + public
  48 + constructor Create(CreateSuspended: Boolean = True);
  49 + destructor Destroy; override;
  50 + end;
  51 +
  52 + { TMessRecvProc }
  53 +
  54 + TMessRecvProc = procedure(AResponse: TStringList) of object;
  55 +
  56 + { TZMQPollThread }
  57 +
  58 + TZMQPollThread = class(TThread)
  59 + private
  60 + FMultipartMessage : TStringList;
  61 + FContext : TZMQContext;
  62 + FSubscriber : TZMQSocket;
  63 + FPoller : TZMQPoller;
  64 + FOnMessageReceived: TMessRecvProc;
  65 + procedure MessageReceived;
  66 + protected
  67 + procedure Execute; override;
  68 + public
  69 + constructor Create(CreateSuspended: Boolean = True);
  70 + destructor Destroy; override;
  71 + property OnMessageReceived : TMessRecvProc read FOnMessageReceived write FOnMessageReceived;
  72 + end;
  73 +
  74 +
  75 +implementation
  76 +
  77 +uses zhelpers;
  78 +
  79 +{ TZMQSubscriber }
  80 +
  81 +procedure TZMQPollThread.MessageReceived;
  82 +begin
  83 + if Assigned(OnMessageReceived) then OnMessageReceived(FMultipartMessage);
  84 +end;
  85 +
  86 +procedure TZMQPollThread.Execute;
  87 +var
  88 + LMultipartMessage : TStringList;
  89 + LPollEvent,
  90 + LMessagesCount : integer;
  91 +begin
  92 +{$IFDEF DEBUG}
  93 + WriteLn('SubThread.Execute');
  94 +{$ENDIF}
  95 + while not Terminated do
  96 + begin
  97 + LPollEvent := FPoller.poll(50000);
  98 + if LPollEvent > 0 then
  99 + begin
  100 + {$IFDEF DEBUG}
  101 + WriteLn('SubThread.Execute.PollMessageReceived');
  102 + {$ENDIF}
  103 + LMultipartMessage := TStringList.Create;
  104 + LMessagesCount := FSubscriber.recv(LMultipartMessage);
  105 + if LMessagesCount > 0 then
  106 + try
  107 + FMultipartMessage := LMultipartMessage;
  108 + Synchronize(@MessageReceived);
  109 + finally
  110 + LMultipartMessage.Free;
  111 + end;
  112 + end;
  113 + end;
  114 +end;
  115 +
  116 +constructor TZMQPollThread.Create(CreateSuspended: Boolean);
  117 +begin
  118 + FreeOnTerminate := True;
  119 + FContext := TZMQContext.create;
  120 + FSubscriber := FContext.Socket( stSub );
  121 + FSubscriber.connect('tcp://localhost:5056');
  122 + FSubscriber.Subscribe('');
  123 +
  124 + FPoller := TZMQPoller.Create(True, FContext);
  125 + // FPoller.onEvent := @PollerEvent; // async
  126 + FPoller.Register(FSubscriber, [pePollIn], True);
  127 + inherited Create(CreateSuspended);
  128 +end;
  129 +
  130 +destructor TZMQPollThread.Destroy;
  131 +begin
  132 + FContext.Free;
  133 + FPoller.Free;
  134 + FSubscriber.Free;
  135 + inherited Destroy;
  136 +end;
  137 +
  138 +{ TZmqPusher }
  139 +
  140 +constructor TZMQPusher.Create;
  141 +begin
  142 + FID := s_random(10);
  143 + FContext := TZMQContext.create;
  144 + FPusher := FContext.Socket( stPush );
  145 + FPusher.connect('tcp://localhost:5057');
  146 +end;
  147 +
  148 +destructor TZMQPusher.Destroy;
  149 +begin
  150 + FContext.Free;
  151 + FPusher.Free;
  152 + inherited Destroy;
  153 +end;
  154 +
  155 +procedure TZMQPusher.SendMessage(AMultipartMessage: array of UTF8string);
  156 +begin
  157 + FPusher.send(AMultipartMessage);
  158 +end;
  159 +
  160 +
  161 +
  162 +{ TZMQPubThread }
  163 +
  164 +procedure TZMQPubThread.Execute;
  165 +var
  166 + LMultipartMessage : TStringList;
  167 + LMessagesCount : integer;
  168 +begin
  169 +{$IFDEF DEBUG}
  170 + WriteLn('PubThread.Execute');
  171 +{$ENDIF}
  172 + while not Terminated do
  173 + begin
  174 + LMultipartMessage := TStringList.Create;
  175 + LMessagesCount := FPuller.recv(LMultipartMessage);
  176 + if LMessagesCount > 0 then
  177 + begin
  178 + {$IFDEF DEBUG}
  179 + WriteLn('PubThread.Execute.MessageReceived');
  180 + {$ENDIF}
  181 + FPublisher.send(LMultiPartMessage);
  182 + end;
  183 + LMultipartMessage.Free;
  184 + end;
  185 +end;
  186 +
  187 +constructor TZMQPubThread.Create(CreateSuspended: Boolean);
  188 +begin
  189 + FreeOnTerminate := True;
  190 +
  191 + FContext := TZMQContext.Create;
  192 + FPublisher := FContext.Socket( stPub );
  193 + FPublisher.bind('tcp://*:5056');
  194 +
  195 + FPuller := FContext.Socket( stPull );
  196 + FPuller.bind('tcp://*:5057');
  197 + inherited Create(CreateSuspended);
  198 +end;
  199 +
  200 +destructor TZMQPubThread.Destroy;
  201 +begin
  202 + FContext.Free;
  203 + FPuller.Free;
  204 + FPublisher.Free;
  205 + inherited Destroy;
  206 +end;
  207 +
  208 +end.