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 38 <PackageName Value="LCL"/>
39 39 </Item3>
40 40 </RequiredPackages>
41   - <Units Count="4">
  41 + <Units Count="9">
42 42 <Unit0>
43 43 <Filename Value="cultural_matrix.lpr"/>
44 44 <IsPartOfProject Value="True"/>
45 45 </Unit0>
46 46 <Unit1>
47   - <Filename Value="form_participant.pas"/>
  47 + <Filename Value="form_matrixgame.pas"/>
48 48 <IsPartOfProject Value="True"/>
49   - <ComponentName Value="Form1"/>
  49 + <ComponentName Value="FormMatrixGame"/>
50 50 <HasResources Value="True"/>
51 51 <ResourceBaseClass Value="Form"/>
52 52 </Unit1>
... ... @@ -61,6 +61,29 @@
61 61 <Filename Value="README.md"/>
62 62 <IsPartOfProject Value="True"/>
63 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 87 </Units>
65 88 </ProjectOptions>
66 89 <CompilerOptions>
... ... @@ -70,6 +93,8 @@
70 93 </Target>
71 94 <SearchPaths>
72 95 <IncludeFiles Value="$(ProjOutDir)"/>
  96 + <Libraries Value="/usr/lib/gcc/x86_64-linux-gnu/4.9/"/>
  97 + <OtherUnitFiles Value="units;../../dependency/delphizmq;../../units"/>
73 98 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
74 99 </SearchPaths>
75 100 <Linking>
... ... @@ -79,6 +104,12 @@
79 104 </Win32>
80 105 </Options>
81 106 </Linking>
  107 + <Other>
  108 + <CustomOptions Value="-dUseCThreads"/>
  109 + <OtherDefines Count="1">
  110 + <Define0 Value="UseCThreads"/>
  111 + </OtherDefines>
  112 + </Other>
82 113 </CompilerOptions>
83 114 <Debugging>
84 115 <Exceptions Count="3">
... ...
cultural_matrix.lpr
  Diff comments   View file @8dc84f5
... ... @@ -15,17 +15,47 @@ uses
15 15 {$IFDEF UNIX}{$IFDEF UseCThreads}
16 16 cthreads,
17 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 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 30 {$R *.res}
23 31  
24 32 begin
25   - RequireDerivedFormResource := True;
  33 + //RequireDerivedFormResource := True;
26 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 59 Application.Run;
30 60 end.
31 61  
... ...
form_chooseactor.lfm 0 → 100644
  Diff comments   View file @8dc84f5
... ... @@ -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 @@
  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 @@
  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 @@
  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   -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   -{
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 @@
  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 @@
  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 @@
  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.
... ...