Skip to content

Commit 6f23f80

Browse files
PascalCorpsmanPascalCorpsman
committed
ADD: update libs
1 parent 75a3ef5 commit 6f23f80

File tree

2 files changed

+146
-16
lines changed

2 files changed

+146
-16
lines changed

‎units/uJSON.pas‎

Lines changed: 85 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
(******************************************************************************)
22
(* uJSON.pas ??.??.???? *)
33
(* *)
4-
(* Version : 0.14 *)
4+
(* Version : 0.15 *)
55
(* *)
66
(* Author : Uwe Schächterle (Corpsman) *)
77
(* *)
@@ -41,12 +41,18 @@
4141
(* 0.13 = Erste Versuche eine Zeilennummer aus zu geben, wenn *)
4242
(* der JSON Text falsch ist.. *)
4343
(* 0.14 = Ignore \u tags instead of throwing an exception *)
44+
(* 0.15 = ADD IJSONAddobjInterface *)
45+
(* Parent Property *)
46+
(* Validy Checks on TJSONArray.addobj *)
47+
(* FIX: linebreak on TJSONNodeObj.ToString *)
4448
(* *)
4549
(******************************************************************************)
4650
Unit uJSON;
4751

4852
{$MODE objfpc}{$H+}
4953

54+
{$INTERFACES CORBA}
55+
5056
Interface
5157

5258
(*
@@ -137,10 +143,12 @@
137143
private
138144
fName: String; // Wird in Findpath benötigt
139145
fobjs: Array Of TJSONObj; // Das ist damit TJSONObj das Findpath bereitstellen kann, sonst müssten das die Kindklassen alle Redundant implementieren
146+
fParent: TJSONObj; // das Eltern JSON Element, wenn es eines gibt, sonst NIL
140147
protected
141148
Procedure Clear; virtual;
142149
public
143150
Tag: PtrInt; // For the User, is not needed by the JSON Library = 0 on Create
151+
Property Parent: TJSONObj read fParent;
144152
Constructor Create; virtual;
145153
Destructor Destroy; override;
146154

@@ -150,9 +158,14 @@
150158
Function Clone: TJSONObj; virtual; // Abstract; // Das Object "Clont" sich selbst und wird als neue Instanz zurück gegeben
151159
End;
152160

161+
IJSONChildobjInterface = Interface
162+
['{121D69AC-9738-455E-B2EA-C80C409D588F}'] // Created with Lazarus IDE, using CTRL+SHIFT+G
163+
Procedure AddObj(JSONObj: TJSONObj);
164+
Function RemoveObj(JSONObj: TJSONObj): Boolean;
165+
End;
153166
{ TJSONComment }
154167

155-
TJSONComment = Class(TJSONObj) // Will man einen JSON 5.0 Kommantar erzeugen der Parser wirft alle Kommentare weg
168+
TJSONComment = Class(TJSONObj) // Falls man einen JSON 5.0 Kommantar erzeugen will, der Parser wirft alle Kommentare weg
156169
private
157170

158171
public
@@ -168,7 +181,7 @@
168181

169182
{ TJSONArray }
170183

171-
TJSONArray = Class(TJSONObj)
184+
TJSONArray = Class(TJSONObj, IJSONChildobjInterface)
172185
private
173186
Function getObjCount: integer;
174187
Function getObj(index: integer): TJSONObj;
@@ -181,6 +194,7 @@
181194
Constructor Create; override;
182195

183196
Procedure AddObj(JSONObj: TJSONObj);
197+
Function RemoveObj(JSONObj: TJSONObj): Boolean;
184198
Procedure Clear; override;
185199

186200
Function ToString(FrontSpace: String = ''): String; override;
@@ -190,7 +204,7 @@
190204

191205
{ TJSONNode }
192206

193-
TJSONNode = Class(TJSONObj)
207+
TJSONNode = Class(TJSONObj, IJSONChildobjInterface)
194208
private
195209
Function getObjCount: integer;
196210
Function getObj(index: integer): TJSONObj;
@@ -201,6 +215,7 @@
201215
Constructor Create; override;
202216

203217
Procedure AddObj(JSONObj: TJSONObj);
218+
Function RemoveObj(JSONObj: TJSONObj): Boolean;
204219
Procedure Clear; override;
205220

206221
Function ToString(FrontSpace: String = ''): String; override;
@@ -366,21 +381,23 @@
366381
{ TJSONTerminal }
367382

368383
Constructor TJSONTerminal.Create(aValue: String);
384+
Var
385+
i: Integer;
369386
Begin
370387
Inherited create;
388+
fName := aValue;
371389
If length(aValue) > 1 Then Begin
372390
If (avalue[1] = '"') And (avalue[length(aValue)] = '"') Then Begin
373391
fName := copy(aValue, 2, length(aValue) - 2);
392+
End;
393+
End;
394+
fIsString := false;
395+
For i := 1 To length(fName) Do Begin
396+
// TODO: Das ist eigentlich falsch, weil es einen String wie 1.1.1 auch als gültige Zahl erkennen würde ..
397+
If Not (fName[i] In ['0'..'9', DefaultFormatSettings.DecimalSeparator]) Then Begin
374398
fIsString := true;
375-
End
376-
Else Begin
377-
fName := aValue; // Eigentlich müsste hier ne AV kommen
378-
fIsString := false;
399+
break;
379400
End;
380-
End
381-
Else Begin
382-
fName := aValue; // Eigentlich müsste hier ne AV kommen
383-
fIsString := false;
384401
End;
385402
End;
386403

@@ -419,6 +436,7 @@
419436
Tag := 0;
420437
fName := '';
421438
fobjs := Nil;
439+
fParent := Nil;
422440
End;
423441

424442
Destructor TJSONObj.Destroy;
@@ -535,13 +553,39 @@
535553
setlength(result.fobjs, length(Self.fobjs));
536554
For i := 0 To high(fobjs) Do Begin
537555
result.fobjs[i] := Self.fobjs[i].Clone;
556+
result.fobjs[i].fParent := result;
538557
End;
539558
End;
540559

541560
Procedure TJSONArray.AddObj(JSONObj: TJSONObj);
542561
Begin
543-
setlength(fobjs, High(fobjs) + 2);
544-
fobjs[High(fobjs)] := JSONObj;
562+
If (JSONObj Is TJSONTerminal) Or
563+
(JSONObj Is TJSONNode) Then Begin
564+
setlength(fobjs, High(fobjs) + 2);
565+
fobjs[High(fobjs)] := JSONObj;
566+
JSONObj.fParent := self;
567+
End
568+
Else Begin
569+
Raise exception.create('Error: ' + JSONObj.ClassName + ' not allowed as element for ' + ClassName);
570+
End;
571+
End;
572+
573+
Function TJSONArray.RemoveObj(JSONObj: TJSONObj): Boolean;
574+
Var
575+
i, j: Integer;
576+
Begin
577+
result := false;
578+
For i := 0 To high(fobjs) Do Begin
579+
If fobjs[i] = JSONObj Then Begin
580+
result := true;
581+
fobjs[i].Free;
582+
For j := i To high(fobjs) - 1 Do Begin
583+
fobjs[j] := fobjs[j + 1];
584+
End;
585+
setlength(fobjs, high(fobjs));
586+
exit;
587+
End;
588+
End;
545589
End;
546590

547591
Procedure TJSONArray.Clear;
@@ -595,13 +639,34 @@
595639
setlength(result.fobjs, length(Self.fobjs));
596640
For i := 0 To high(fobjs) Do Begin
597641
result.fobjs[i] := Self.fobjs[i].Clone;
642+
result.fobjs[i].fParent := result;
598643
End;
599644
End;
600645

601646
Procedure TJSONNode.AddObj(JSONObj: TJSONObj);
602647
Begin
648+
// TODO: darf hier wirklich alles hinzugefügt werden ?
603649
setlength(fobjs, High(fobjs) + 2);
604650
fobjs[High(fobjs)] := JSONObj;
651+
JSONObj.fParent := self;
652+
End;
653+
654+
Function TJSONNode.RemoveObj(JSONObj: TJSONObj): Boolean;
655+
Var
656+
i, j: Integer;
657+
Begin
658+
result := false;
659+
For i := 0 To high(fobjs) Do Begin
660+
If fobjs[i] = JSONObj Then Begin
661+
result := true;
662+
fobjs[i].Free;
663+
For j := i To high(fobjs) - 1 Do Begin
664+
fobjs[j] := fobjs[j + 1];
665+
End;
666+
setlength(fobjs, high(fobjs));
667+
exit;
668+
End;
669+
End;
605670
End;
606671

607672
Procedure TJSONNode.Clear;
@@ -917,12 +982,17 @@
917982
Inherited Create;
918983
fName := aName;
919984
fvalue := aValue;
985+
fvalue.fParent := self;
920986
End;
921987

922988
Function TJSONNodeObj.ToString(FrontSpace: String): String;
989+
Var
990+
maybeLE: String;
923991
Begin
924992
If assigned(fvalue) Then Begin
925-
result := FrontSpace + StringToJsonString(fName) + ':' + fvalue.ToString(FrontSpace);
993+
maybeLE := '';
994+
If fvalue Is TJSONNode Then maybeLE := LineEnding;
995+
result := FrontSpace + StringToJsonString(fName) + ':' + maybeLE + fvalue.ToString(FrontSpace);
926996
End
927997
Else Begin
928998
result := FrontSpace + StringToJsonString(fName) + ':""';

‎units/uopengl_graphikengine.pas‎

Lines changed: 61 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -178,6 +178,7 @@
178178
Procedure RenderAlphaRQuad(TopLeft, BottomRight: TPoint; Angle: Integer; RotatebyOrigin: Boolean = False; Texture: Integer = 0); overload; // Fertig Getestet
179179
Procedure RenderAlphaRQuad(TopLeft, BottomRight: TVector2; Angle: Integer; RotatebyOrigin: Boolean = False; Texture: Integer = 0); overload; // Fertig Getestet
180180
Procedure RenderAlphaImage(Value: TSubImage);
181+
Procedure RenderAlphaTiledQuad(Left, Top: Single; Index, TilesPerRow, TilesPerCol: integer; Const Image: TGraphikItem);
181182

182183
Procedure RenderQuad(Top, Left: Single; Image: TGraphikItem); overload; // WTF: warum ist hier top und left vertauscht ?
183184
Procedure RenderQuad(Middle: TVector2; Angle: Single; Image: TGraphikItem); overload;
@@ -186,6 +187,8 @@
186187

187188
Procedure RenderQuad(TopLeft, BottomRight: TPoint; Angle: Integer; RotatebyOrigin: Boolean = False; Texture: Integer = 0); overload; // Fertig Getestet
188189
Procedure RenderQuad(TopLeft, BottomRight: TVector2; Angle: Integer; RotatebyOrigin: Boolean = False; Texture: Integer = 0); overload; // Fertig Getestet
190+
Procedure RenderTiledQuad(Left, Top: Single; Index, TilesPerRow, TilesPerCol: integer; Const Image: TGraphikItem);
191+
189192
(*
190193
Rendert einen Kreis, ohne Füllung
191194
*)
@@ -377,6 +380,20 @@
377380
gldisable(gl_blend);
378381
End;
379382

383+
Procedure RenderAlphaTiledQuad(Left, Top: Single; Index, TilesPerRow,
384+
TilesPerCol: integer; Const Image: TGraphikItem);
385+
Var
386+
b: {$IFDEF USE_GL}Byte{$ELSE}Boolean{$ENDIF};
387+
Begin
388+
B := glIsEnabled(gl_Blend);
389+
If Not (b{$IFDEF USE_GL} = 1{$ENDIF}) Then
390+
glenable(gl_Blend);
391+
glBlendFunc(GL_ONE_MINUS_SRC_ALPHA, GL_SRC_ALPHA);
392+
RenderTiledQuad(Left, Top, Index, TilesPerRow, TilesPerCol, Image);
393+
If Not (b{$IFDEF USE_GL} = 1{$ENDIF}) Then
394+
gldisable(gl_blend);
395+
End;
396+
380397
Function IsPowerOfTwo(Value: Integer): Boolean;
381398
Var
382399
i: Integer;
@@ -495,6 +512,49 @@
495512
RenderQuad(v2((TopLeft.x + BottomRight.x) / 2, (TopLeft.y + BottomRight.y) / 2), abs(BottomRight.x - TopLeft.x), abs(TopLeft.y - BottomRight.y), angle, Texture);
496513
End;
497514

515+
(*
516+
* Die Idee, ist dass wir die Textur betrachten als "Collection" von vielen Tiles
517+
* Diese collection wird zu einer Rechteckfläche von TilesPerRow und TilesPerCol
518+
* in die wir via Index zugreifen, und dann immer nur das passende "teilstück"
519+
* Rendern ;).
520+
*)
521+
522+
Procedure RenderTiledQuad(Left, Top: Single; Index, TilesPerRow,
523+
TilesPerCol: integer; Const Image: TGraphikItem);
524+
Var
525+
w, h, tw, th: Single;
526+
ix, iy: integer;
527+
Begin
528+
ix := index Mod TilesPerRow;
529+
iy := index Div TilesPerRow;
530+
w := Image.OrigWidth / TilesPerRow;
531+
h := Image.OrigHeight / TilesPerCol;
532+
Case Image.Stretched Of
533+
smClamp: Begin
534+
tw := w / Image.StretchedWidth;
535+
th := h / Image.StretchedHeight;
536+
End;
537+
smNone, smStretch, smStretchHard: Begin
538+
tw := w;
539+
th := h;
540+
End;
541+
End;
542+
glBindTexture(gl_texture_2d, image.Image);
543+
glpushmatrix;
544+
gltranslatef(left, top, 0);
545+
glbegin(gl_quads);
546+
glTexCoord2f(tw * ix, th * (iy + 1));
547+
glvertex3f(0, h, 0);
548+
glTexCoord2f(tw * (ix + 1), th * (iy + 1));
549+
glvertex3f(w, h, 0);
550+
glTexCoord2f(tw * (ix + 1), th * iy);
551+
glvertex3f(w, 0, 0);
552+
glTexCoord2f(tw * ix, th * iy);
553+
glvertex3f(0, 0, 0);
554+
glend;
555+
glpopmatrix;
556+
End;
557+
498558
Procedure RenderQuad(TopLeft, BottomRight: TPoint; Angle: Integer; RotatebyOrigin: Boolean = False; Texture: Integer = 0);
499559
Var
500560
w2, h2: integer;
@@ -1260,7 +1320,7 @@
12601320
exit;
12611321
End;
12621322
End;
1263-
raise exception.Create('TOpenGL_GraphikEngine.LoadAlphaColorGraphikItem: Unable to load');
1323+
Raise exception.Create('TOpenGL_GraphikEngine.LoadAlphaColorGraphikItem: Unable to load');
12641324
End;
12651325

12661326
Function TOpenGL_GraphikEngine.LoadAlphaColorGraphik(Filename: String; Color: TRGB; Stretch: TStretchmode): Integer; // Lädt eine Alphagraphik und setzt den Wert von Color = Transparent.

0 commit comments

Comments
 (0)