1 (*
2 * The contents of this file are subject to the Mozilla Public License
3 * Version 1.1 (the "License"); you may not use this file except in
4 * compliance with the License. You may obtain a copy of the License at
5 * http://www.mozilla.org/MPL/
6 *
7 * Software distributed under the License is distributed on an "AS IS"
8 * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
9 * License for the specific language governing rights and limitations
10 * under the License.
11 *
12 * The Initial Developer of this code is John Hansen.
13 * Portions created by John Hansen are Copyright (C) 2009 John Hansen.
14 * All Rights Reserved.
15 *
16 *)
17 unit uRICComp;
18
19 interface
20
21 uses
22 Classes, Contnrs, uNBCCommon, uRIC, Parser10;
23
24 type
25 TImgPoint = IMG_PT;
26 TImgRect = IMG_RECT;
27 TImgCanvas = TObject;
28
29 TRICOps = class(TObjectList)
30 public
31 constructor Create;
32 destructor Destroy; override;
33 // procedure Draw(aPoint : TImgPoint; Vars : TRICVariables; Options : Cardinal; aCanvas : TImgCanvas);
34 end;
35
36 TRICOpBase = class
37 protected
38 fOwner : TRICOps;
39 fOpSize : Word;
40 fOpCode : Word;
GetOpSizenull41 function GetOpSize : Word; virtual;
42 public
43 constructor Create(aOwner : TRICOps); virtual;
44 destructor Destroy; override;
45 procedure SaveToStream(aStream : TStream); virtual;
46 procedure LoadFromStream(aStream : TStream); virtual;
SaveAsDataArraynull47 function SaveAsDataArray(const aLangName: TLangName): string; virtual;
48 // procedure Draw(aPoint : TImgPoint; Vars : TRICVariables; Options : Cardinal; aCanvas : TImgCanvas); virtual; abstract;
49 property OpSize : Word read GetOpSize write fOpSize;
50 property OpCode : Word read fOpCode write fOpCode;
51 end;
52
53 TRICDescription = class(TRICOpBase)
54 protected
55 fOptions : Word;
56 fWidth : Word;
57 fHeight : Word;
58 public
59 constructor Create(aOwner : TRICOps); override;
60 procedure SaveToStream(aStream : TStream); override;
61 procedure LoadFromStream(aStream : TStream); override;
SaveAsDataArraynull62 function SaveAsDataArray(const aLangName: TLangName): string; override;
63 // procedure Draw(aPoint : TImgPoint; Vars : TRICVariables; Options : Cardinal; aCanvas : TImgCanvas); override;
64 property Options : Word read fOptions write fOptions;
65 property Width : Word read fWidth write fWidth;
66 property Height : Word read fHeight write fHeight;
67 end;
68
69 TByteObject = class
70 private
71 fValue: Byte;
72 public
73 property Value : Byte read fValue write fValue;
74 end;
75
76 TRICSprite = class(TRICOpBase)
77 protected
78 fDataAddr: Word;
79 fRowBytes: Word;
80 fRows: Word;
81 fBytes : TObjectList;
GetByteCountnull82 function GetByteCount: Integer;
GetBytenull83 function GetByte(Index: Integer): Byte;
84 procedure SetByte(Index: Integer; const Value: Byte);
GetOpSizenull85 function GetOpSize : Word; override;
BytesToWritenull86 function BytesToWrite : Integer;
GetByteValuenull87 function GetByteValue(const idx : integer) : Byte;
88 public
89 constructor Create(aOwner : TRICOps); override;
90 destructor Destroy; override;
91 procedure SaveToStream(aStream : TStream); override;
92 procedure LoadFromStream(aStream : TStream); override;
SaveAsDataArraynull93 function SaveAsDataArray(const aLangName: TLangName): string; override;
94 // procedure Draw(aPoint : TImgPoint; Vars : TRICVariables; Options : Cardinal; aCanvas : TImgCanvas); override;
95 procedure Add(aValue : Byte);
96 property DataAddr : Word read fDataAddr write fDataAddr;
97 property Rows : Word read fRows write fRows;
98 property RowBytes : Word read fRowBytes write fRowBytes;
99 property ByteCount : Integer read GetByteCount;
100 property Bytes[Index : Integer] : Byte read GetByte write SetByte;
101 procedure AddBytes(val : string);
CountBytesnull102 class function CountBytes(val : string) : Word;
103 end;
104
105 TMapElement = class
106 private
107 fRange: Word;
108 fDomain: Word;
109 public
110 property Domain : Word read fDomain write fDomain;
111 property Range : Word read fRange write fRange;
112 end;
113
114 TRICVarMap = class(TRICOpBase)
115 private
116 protected
117 fDataAddr: Word;
118 fMapElements : TObjectList;
GetMapCountnull119 function GetMapCount: Word;
GetMapElementnull120 function GetMapElement(Index: Integer): TMapElement;
121 procedure SetMapElement(Index: Integer; const Value: TMapElement);
122 public
123 constructor Create(aOwner : TRICOps); override;
124 destructor Destroy; override;
125 procedure SaveToStream(aStream : TStream); override;
126 procedure LoadFromStream(aStream : TStream); override;
SaveAsDataArraynull127 function SaveAsDataArray(const aLangName: TLangName): string; override;
128 // procedure Draw(aPoint : TImgPoint; Vars : TRICVariables; Options : Cardinal; aCanvas : TImgCanvas); override;
129 procedure AddMap(aMapElement : PIOV_MAPELT);
Addnull130 function Add : TMapElement;
131 property DataAddr : Word read fDataAddr write fDataAddr;
132 property MapCount : Word read GetMapCount;
133 property MapElements[Index : Integer] : TMapElement read GetMapElement write SetMapElement;
134 end;
135
136 TRICCopyBits = class(TRICOpBase)
137 protected
138 fCopyOptions : Word;
139 fDataAddr : Word;
140 fDestPoint: TImgPoint;
141 fSrcRect: TImgRect;
142 public
143 constructor Create(aOwner : TRICOps); override;
144 procedure SaveToStream(aStream : TStream); override;
145 procedure LoadFromStream(aStream : TStream); override;
SaveAsDataArraynull146 function SaveAsDataArray(const aLangName: TLangName): string; override;
147 // procedure Draw(aPoint : TImgPoint; Vars : TRICVariables; Options : Cardinal; aCanvas : TImgCanvas); override;
148 property CopyOptions : Word read fCopyOptions write fCopyOptions;
149 property DataAddr : Word read fDataAddr write fDataAddr;
150 property SrcRect : TImgRect read fSrcRect write fSrcRect;
151 property DestPoint : TImgPoint read fDestPoint write fDestPoint;
152 end;
153
154 TRICPixel = class(TRICOpBase)
155 protected
156 fCopyOptions : Word;
157 fPoint: TImgPoint;
158 fValue: Word;
159 public
160 constructor Create(aOwner : TRICOps); override;
161 procedure SaveToStream(aStream : TStream); override;
162 procedure LoadFromStream(aStream : TStream); override;
SaveAsDataArraynull163 function SaveAsDataArray(const aLangName: TLangName): string; override;
164 // procedure Draw(aPoint : TImgPoint; Vars : TRICVariables; Options : Cardinal; aCanvas : TImgCanvas); override;
165 property CopyOptions : Word read fCopyOptions write fCopyOptions;
166 property Point : TImgPoint read fPoint write fPoint;
167 property Value : Word read fValue write fValue;
168 end;
169
170 TRICLine = class(TRICOpBase)
171 protected
172 fCopyOptions : Word;
173 fPoint1: TImgPoint;
174 fPoint2: TImgPoint;
175 public
176 constructor Create(aOwner : TRICOps); override;
177 procedure SaveToStream(aStream : TStream); override;
178 procedure LoadFromStream(aStream : TStream); override;
SaveAsDataArraynull179 function SaveAsDataArray(const aLangName: TLangName): string; override;
180 // procedure Draw(aPoint : TImgPoint; Vars : TRICVariables; Options : Cardinal; aCanvas : TImgCanvas); override;
181 property CopyOptions : Word read fCopyOptions write fCopyOptions;
182 property Point1 : TImgPoint read fPoint1 write fPoint1;
183 property Point2 : TImgPoint read fPoint2 write fPoint2;
184 end;
185
186 TRICRect = class(TRICOpBase)
187 protected
188 fCopyOptions : Word;
189 fPoint: TImgPoint;
190 fHeight: SmallInt;
191 fWidth: SmallInt;
192 public
193 constructor Create(aOwner : TRICOps); override;
194 procedure SaveToStream(aStream : TStream); override;
195 procedure LoadFromStream(aStream : TStream); override;
SaveAsDataArraynull196 function SaveAsDataArray(const aLangName: TLangName): string; override;
197 // procedure Draw(aPoint : TImgPoint; Vars : TRICVariables; Options : Cardinal; aCanvas : TImgCanvas); override;
198 property CopyOptions : Word read fCopyOptions write fCopyOptions;
199 property Point : TImgPoint read fPoint write fPoint;
200 property Width : SmallInt read fWidth write fWidth;
201 property Height : SmallInt read fHeight write fHeight;
202 end;
203
204 TRICCircle = class(TRICOpBase)
205 protected
206 fCopyOptions : Word;
207 fPoint: TImgPoint;
208 fRadius: Word;
209 public
210 constructor Create(aOwner : TRICOps); override;
211 procedure SaveToStream(aStream : TStream); override;
212 procedure LoadFromStream(aStream : TStream); override;
SaveAsDataArraynull213 function SaveAsDataArray(const aLangName: TLangName): string; override;
214 // procedure Draw(aPoint : TImgPoint; Vars : TRICVariables; Options : Cardinal; aCanvas : TImgCanvas); override;
215 property CopyOptions : Word read fCopyOptions write fCopyOptions;
216 property Point : TImgPoint read fPoint write fPoint;
217 property Radius : Word read fRadius write fRadius;
218 end;
219
220 TRICNumBox = class(TRICOpBase)
221 protected
222 fCopyOptions : Word;
223 fPoint: TImgPoint;
224 fValue: Word;
225 public
226 constructor Create(aOwner : TRICOps); override;
227 procedure SaveToStream(aStream : TStream); override;
228 procedure LoadFromStream(aStream : TStream); override;
SaveAsDataArraynull229 function SaveAsDataArray(const aLangName: TLangName): string; override;
230 // procedure Draw(aPoint : TImgPoint; Vars : TRICVariables; Options : Cardinal; aCanvas : TImgCanvas); override;
231 property CopyOptions : Word read fCopyOptions write fCopyOptions;
232 property Point : TImgPoint read fPoint write fPoint;
233 property Value : Word read fValue write fValue;
234 end;
235
236 TRICEllipse = class(TRICOpBase)
237 protected
238 fCopyOptions : Word;
239 fPoint: TImgPoint;
240 fRadius1: Word;
241 fRadius2: Word;
242 public
243 constructor Create(aOwner : TRICOps); override;
244 procedure SaveToStream(aStream : TStream); override;
245 procedure LoadFromStream(aStream : TStream); override;
SaveAsDataArraynull246 function SaveAsDataArray(const aLangName: TLangName): string; override;
247 // procedure Draw(aPoint : TImgPoint; Vars : TRICVariables; Options : Cardinal; aCanvas : TImgCanvas); override;
248 property CopyOptions : Word read fCopyOptions write fCopyOptions;
249 property Point : TImgPoint read fPoint write fPoint;
250 property Radius1 : Word read fRadius1 write fRadius1;
251 property Radius2 : Word read fRadius2 write fRadius2;
252 end;
253
254 TPolyPoint = class
255 private
256 fX: SmallInt;
257 fY: SmallInt;
258 public
259 property X : SmallInt read fX write fX;
260 property Y : SmallInt read fY write fY;
261 end;
262
263 TRICPolygon = class(TRICOpBase)
264 private
265 protected
266 fCopyOptions : Word;
267 fPolyPoints : TObjectList;
GetCountnull268 function GetCount: Word;
GetPolyPointnull269 function GetPolyPoint(Index: Integer): TPolyPoint;
270 procedure SetPolyPoint(Index: Integer; const Value: TPolyPoint);
271 public
272 constructor Create(aOwner : TRICOps); override;
273 destructor Destroy; override;
274 procedure SaveToStream(aStream : TStream); override;
275 procedure LoadFromStream(aStream : TStream); override;
SaveAsDataArraynull276 function SaveAsDataArray(const aLangName: TLangName): string; override;
277 // procedure Draw(aPoint : TImgPoint; Vars : TRICVariables; Options : Cardinal; aCanvas : TImgCanvas); override;
278 procedure AddPoint(aPolyPoint : PIMG_PT);
Addnull279 function Add : TPolyPoint;
280 property Count : Word read GetCount;
281 property PolyPoints[Index : Integer] : TPolyPoint read GetPolyPoint write SetPolyPoint;
282 property CopyOptions : Word read fCopyOptions write fCopyOptions;
283 end;
284
285 TRICComp = class
286 private
287 endofallsource : boolean;
288 fBadProgram : boolean;
289 fBytesRead : integer;
290 fProgErrorCount : integer;
291 fOptimize: boolean;
292 fCurFile: string;
293 fEnhancedFirmware: boolean;
294 fMessages: TStrings;
295 fOnCompMSg: TOnCompilerMessage;
296 fCalc : TExpParser;
297 fMaxErrors: word;
298 fFirmwareVersion: word;
299 procedure InternalParseStream;
300 procedure ReportProblem(const lineNo: integer; const fName,
301 msg: string; err: boolean);
302 procedure Init;
303 procedure GetChar;
304 procedure GetCharX;
305 procedure IncLineNumber;
306 procedure Next;
307 procedure SkipWhite;
308 procedure SkipLine;
309 procedure SkipCommentBlock;
310 procedure GetHexNum;
311 procedure GetName;
312 procedure GetNum;
313 procedure Expected(s: string);
314 procedure AbortMsg(s: string);
IsAlphanull315 function IsAlpha(c: char): boolean;
IsWhitenull316 function IsWhite(c: char): boolean;
IsAlNumnull317 function IsAlNum(c: char): boolean;
IsDigitnull318 function IsDigit(c: char): boolean;
IsHexnull319 function IsHex(c: char): boolean;
320 procedure GetOp;
321 procedure ScriptCommands;
322 procedure Scan;
323 procedure CheckBytesRead(const oldBytesRead: integer);
324 procedure MatchString(x: string);
325 procedure Semi;
326 procedure Statement;
327 procedure DoDesc;
328 procedure DoSprite;
329 procedure DoCircle;
330 procedure DoCopyBits;
331 procedure DoLine;
332 procedure DoNumBox;
333 procedure DoPixel;
334 procedure DoRect;
335 procedure DoVarMap;
336 procedure DoEllipse;
337 procedure DoPolygon;
338 procedure DoFontOut;
339 procedure CloseParen;
340 procedure CheckNumeric;
ProcessArgnull341 function ProcessArg: SmallInt;
ProcessWordArgnull342 function ProcessWordArg: Word;
ValueToIntnull343 function ValueToInt: integer;
ValueToSmallIntnull344 function ValueToSmallInt: SmallInt;
ValueToWordnull345 function ValueToWord: Word;
StringToIntnull346 function StringToInt(const val: string): integer;
347 procedure OpenParen;
348 procedure GetString;
349 procedure CheckStringConst;
350 procedure CheckFirmwareVersion(const MinVer : word; const msg : string);
351 protected
352 fMS : TMemoryStream;
353 fOperations : TRICOps;
354 fCurrentLine : string;
355 fTempChar : Char;
356 fParenDepth : integer;
357 fIncludeDirs: TStrings;
GetOpCountnull358 function GetOpCount: Integer;
359 procedure SyncObjectListToStream;
360 procedure SyncStreamToObjectList;
GetAsTextnull361 function GetAsText: string;
362 procedure SetAsText(const Value: string);
GetOperationnull363 function GetOperation(Index: integer): TRICOpBase;
364 procedure Clear;
365 public
366 constructor Create; virtual;
367 destructor Destroy; override;
368 property CompilerMessages : TStrings read fMessages;
369 procedure LoadFromStream(aStream : TStream);
370 procedure LoadFromFile(const aFilename : string);
371 procedure SaveToStream(aStream : TStream);
372 procedure SaveToFile(const aFilename : string);
373 // procedure Draw(aPoint : TImgPoint; Vars : TRICVariables; Options : Cardinal; aCanvas : TImgCanvas);
374 procedure Parse(const aFilename : string); overload;
375 procedure Parse(aStream : TStream); overload;
376 procedure Parse(aStrings : TStrings); overload;
SaveAsDataArraynull377 function SaveAsDataArray(const aLangName : TLangName; varname : string) : string;
378 property RICOps : TRICOps read fOperations;
379 property Operations[Index : integer] : TRICOpBase read GetOperation;
380 property OperationCount : Integer read GetOpCount;
381 property AsText : string read GetAsText write SetAsText;
382 property CurrentFile : string read fCurFile write fCurFile;
383 property Optimize : boolean read fOptimize write fOptimize;
384 property EnhancedFirmware : boolean read fEnhancedFirmware write fEnhancedFirmware;
385 property FirmwareVersion : word read fFirmwareVersion write fFirmwareVersion;
386 property MaxErrors : word read fMaxErrors write fMaxErrors;
387 property OnCompilerMessage : TOnCompilerMessage read fOnCompMSg write fOnCompMsg;
388 property IncludeDirs : TStrings read fIncludeDirs;
RICToTextnull389 class function RICToText(aStream : TStream; const aFilename : string = '') : string; overload;
RICToTextnull390 class function RICToText(const aFilename : string) : string; overload;
RICToDataArraynull391 class function RICToDataArray(const aFilename, aVarName : string; const aLangName : TLangName) : string;
392 end;
393
394 implementation
395
396 uses
397 SysUtils, Math, uCommonUtils, uLocalizedStrings,
398 {$IFNDEF FPC}
399 Graphics, JPEG, pngimage, GIFImage
400 {$ELSE}
401 FPImage, FPCanvas,
402 FPReadBMP, {FPReadGIF, }FPReadJpeg,
403 FPReadPCX, FPReadPNG, FPReadPNM,
404 FPReadTGA, {FPReadTiff, }FPReadXPM
405 {$ENDIF};
406
407 type
408 TRGBColor = record
409 red : Byte;
410 green : Byte;
411 blue : Byte;
412 end;
413
414 THSBColor = record
415 Hue : Double;
416 Saturation : Double;
417 Brightness : Double;
418 end;
419
RGB2HSBnull420 function RGB2HSB( rgb:TRGBColor ) : THSBColor;
421 var
422 minRGB : Double;
423 maxRGB : Double;
424 delta : Double;
425 h : Double;
426 s : Double;
427 b : Double;
428 begin
429 h := 0.0;
430 minRGB := Min( Min( rgb.Red,rgb.Green ),rgb.Blue );
431 maxRGB := Max( Max( rgb.Red,rgb.Green ),rgb.Blue );
432 delta := maxRGB - minRGB;
433 b := maxRGB ;
434
435 if maxRGB <> 0.0 then
436 s := 255.0 * delta / maxRGB
437 else
438 s := 0.0;
439
440 if s <> 0.0 then
441 begin
442 if rgb.Red = maxRGB then
443 h := (rgb.Green - rgb.Blue) / delta
444 else if rgb.Green = minRGB then
445 h := 2.0 + (rgb.Blue - rgb.Red) / delta
446 else if rgb.Blue = maxRGB then
447 h := 4.0 + (rgb.Red - rgb.Green) / delta
448 end
449 else
450 h := -1.0;
451
452 h := h * 60;
453 if h < 0.0 then
454 h := h + 360.0;
455
456 with result do
457 begin
458 Hue := h;
459 Saturation := s * 100 / 255;
460 Brightness := b * 100 / 255;
461 end;
462 end;
463
464 {$IFNDEF FPC}
465 procedure ImportImage(op : TRICSprite; const fname : string;
466 threshold, width, height : integer);
467 var
468 pic : TPicture;
469 img : TBitmap;
470 w, h, nw, nh, x, y, c : Integer;
471 rgb : TRGBColor;
472 hsb : THSBColor;
473 row : string;
474 begin
475 img := TBitmap.Create;
476 try
477 pic := TPicture.Create;
478 try
479 pic.LoadFromFile(fname);
480 w := pic.Graphic.Width;
481 h := pic.Graphic.Height;
482 img.Width := w;
483 img.Height := h;
484 img.Canvas.Draw( 0,0, pic.Graphic );
485 finally
486 pic.Free;
487 end;
488 // now generate the pixel bytes for the NXT sprite
489 nw := Min(width, w);
490 nh := Min(height, h);
491 op.Rows := nh;
492 x := nw div 8;
493 if (nw mod 8) <> 0 then
494 inc(x);
495 op.RowBytes := x;
496 for y := 0 to nh-1 do begin
497 row := '';
498 for x := 0 to nw-1 do begin
499 c := img.Canvas.Pixels[ x,y ];
500 rgb.red := Byte( ( c and $00FF0000 ) shr 16 );
501 rgb.green := Byte( ( c and $0000FF00 ) shr 8 );
502 rgb.blue := Byte( c and $000000FF );
503 hsb := RGB2HSB( rgb );
504 if ( hsb.Brightness > threshold ) then
505 row := row + '0'
506 else
507 row := row + '1';
508 end;
509 op.AddBytes(row);
510 end;
511 finally
512 img.Free;
513 end;
514 end;
515 {$ELSE}
516 procedure ImportImage(op : TRICSprite; const fname : string;
517 threshold, width, height : integer);
518 var
519 img : TFPMemoryImage;
520 w, h, nw, nh, x, y : Integer;
521 c : TFPColor;
522 rgb : TRGBColor;
523 hsb : THSBColor;
524 row : string;
525 begin
526 img := TFPMemoryImage.Create(0, 0);
527 try
528 img.LoadFromFile(fname);
529 w := img.Width;
530 h := img.Height;
531 // now generate the pixel bytes for the NXT sprite
532 nw := Min(width, w);
533 nh := Min(height, h);
534 op.Rows := nh;
535 x := nw div 8;
536 if (nw mod 8) <> 0 then
537 inc(x);
538 op.RowBytes := x;
539 for y := 0 to nh-1 do begin
540 row := '';
541 for x := 0 to nw-1 do begin
542 c := img.Colors[ x,y ];
543 rgb.red := c.red;
544 rgb.green := c.green;
545 rgb.blue := c.blue;
546 hsb := RGB2HSB( rgb );
547 if ( hsb.Brightness > threshold ) then
548 row := row + '0'
549 else
550 row := row + '1';
551 end;
552 op.AddBytes(row);
553 end;
554 finally
555 img.Free;
556 end;
557 end;
558 {$ENDIF}
559
560 const
561 TAB = ^I;
562 CR = ^M;
563 LF = ^J;
564 TOK_NUM = 'N';
565 TOK_HEX = 'H';
566 TOK_STRINGLIT = 'G';
567 TOK_OPENPAREN = '(';
568 TOK_CLOSEPAREN = ')';
569 TOK_COMMA = ',';
570 TOK_IDENTIFIER = 'x';
571 TOK_DESC = 'd';
572 TOK_SPRITE = 's';
573 TOK_COPYBITS = 'c';
574 TOK_VARMAP = 'v';
575 TOK_IMPORT = 'i';
576 TOK_LINE = 'l';
577 TOK_RECT = 'r';
578 TOK_PIXEL = 'p';
579 TOK_CIRCLE = 'C';
580 TOK_NUMBOX = 'n';
581 TOK_ARG = 'a';
582 TOK_MAPARG = 'm';
583 TOK_F = 'f';
584 TOK_ELLIPSE = 'e';
585 TOK_POLYGON = 'P';
586 TOK_FONTOUT = 'F';
587 TOK_BLOCK_COMMENT = #01;
588 TOK_LINE_COMMENT = #02;
589
590 var
591 Look: char = LF; { Lookahead Character }
592 Token: char; { Encoded Token }
593 Value: string; { Unencoded Token }
594
595 var
596 slevel : integer = 1;
597 linenumber : integer; // current source line number
598 totallines : integer = 0;
599
600 const
601 NKW = 16;
602 NKW1 = 17;
603
604 const
605 KWlist: array[1..NKW] of string =
606 ('desc', 'sprite', 'varmap', 'import',
607 'copybits', 'line', 'rect', 'pixel',
608 'circle', 'numbox', 'maparg', 'arg', 'f',
609 'ellipse', 'polygon', 'fontout');
610
611 const
612 KWcode: array[1..NKW1+1] of Char =
613 (TOK_IDENTIFIER, TOK_DESC, TOK_SPRITE,
614 TOK_VARMAP, TOK_IMPORT, TOK_COPYBITS, TOK_LINE,
615 TOK_RECT, TOK_PIXEL, TOK_CIRCLE,
616 TOK_NUMBOX, TOK_MAPARG, TOK_ARG, TOK_F,
617 TOK_ELLIPSE, TOK_POLYGON, TOK_FONTOUT,
618 #0);
619
620 type
621 SymTab = array[1..NKW] of string;
622 TabPtr = ^SymTab;
623
PixelsToBytesnull624 function PixelsToBytes(p : word) : word;
625 begin
626 Result := Word(p div 8);
627 if (p mod 8) <> 0 then
628 Inc(Result);
629 end;
630
631 procedure WriteImgPointToStream(aStream : TStream; pt : TImgPoint; bLittleEndian : Boolean = True);
632 begin
633 WriteSmallIntToStream(aStream, pt.X, bLittleEndian);
634 WriteSmallIntToStream(aStream, pt.Y, bLittleEndian);
635 end;
636
637 procedure WriteImgRectToStream(aStream : TStream; R : TImgRect; bLittleEndian : Boolean = True);
638 begin
639 WriteImgPointToStream(aStream, R.Pt, bLittleEndian);
640 WriteSmallIntToStream(aStream, R.Width, bLittleEndian);
641 WriteSmallIntToStream(aStream, R.Height, bLittleEndian);
642 end;
643
644 procedure ReadImgPointFromStream(aStream : TStream; var pt : TImgPoint; bLittleEndian : Boolean = True);
645 begin
646 ReadSmallIntFromStream(aStream, pt.X, bLittleEndian);
647 ReadSmallIntFromStream(aStream, pt.Y, bLittleEndian);
648 end;
649
650 procedure ReadImgRectFromStream(aStream : TStream; var R : TImgRect; bLittleEndian : Boolean = True);
651 begin
652 ReadImgPointFromStream(aStream, R.Pt, bLittleEndian);
653 ReadSmallIntFromStream(aStream, R.Width, bLittleEndian);
654 ReadSmallIntFromStream(aStream, R.Height, bLittleEndian);
655 end;
656
RICOpCodeToStrnull657 function RICOpCodeToStr(const Op : Word; const Options : Word = 0) : string;
658 begin
659 case Op of
660 IMG_DESCRIPTION_ID : begin
661 if Options = $8001 then
662 Result := 'fontout'
663 else
664 Result := 'desc';
665 end;
666 IMG_SPRITE_ID : Result := 'sprite';
667 IMG_VARMAP_ID : Result := 'varmap';
668 IMG_COPYBITS_ID : Result := 'copybits';
669 IMG_PIXEL_ID : Result := 'pixel';
670 IMG_LINE_ID : Result := 'line';
671 IMG_RECTANGLE_ID : Result := 'rect';
672 IMG_CIRCLE_ID : Result := 'circle';
673 IMG_NUMBOX_ID : Result := 'numbox';
674 IMG_ELLIPSE_ID : Result := 'ellipse';
675 IMG_POLYGON_ID : Result := 'polygon';
676 else
677 Result := 'unknown';
678 end;
679 end;
680
SpriteByteToHexStringnull681 function SpriteByteToHexString(const B : Byte) : string;
682 begin
683 Result := IntToHex(B, 2);
684 end;
685
SpriteByteToBinaryStringnull686 function SpriteByteToBinaryString(const B : Byte) : string;
687 begin
688 Result := '';
689 if (B and $80) <> 0 then Result := Result + '1'
690 else Result := Result + '0';
691 if (B and $40) <> 0 then Result := Result + '1'
692 else Result := Result + '0';
693 if (B and $20) <> 0 then Result := Result + '1'
694 else Result := Result + '0';
695 if (B and $10) <> 0 then Result := Result + '1'
696 else Result := Result + '0';
697 if (B and $08) <> 0 then Result := Result + '1'
698 else Result := Result + '0';
699 if (B and $04) <> 0 then Result := Result + '1'
700 else Result := Result + '0';
701 if (B and $02) <> 0 then Result := Result + '1'
702 else Result := Result + '0';
703 if (B and $01) <> 0 then Result := Result + '1'
704 else Result := Result + '0';
705 end;
706
RICValueToStrnull707 function RICValueToStr(const val : integer; const aLangName : TLangName = lnRICScript) : string;
708 var
709 fmtStr : string;
710 begin
711 if aLangName in [lnNBC, lnNXC] then
712 begin
713 Result := Format('0x%2.2x, 0x%2.2x', [Lo(val), Hi(val)]);
714 end
715 else
716 begin
717 if IMG_SYMB_USEARGS(val) = 0 then
718 begin
719 Result := Format('%d', [val]);
720 end
721 else
722 begin
723 if IMG_SYMB_MAP(val) = 0 then
724 begin
725 if aLangName = lnRICSCript then
726 fmtStr := 'arg(%d)'
727 else
728 fmtStr := 'RICArg(%d)';
729 Result := Format(fmtStr, [IMG_SYMB_ARG(val)]);
730 end
731 else
732 begin
733 if aLangName = lnRICSCript then
734 fmtStr := 'maparg(%d, %d)'
735 else
736 fmtStr := 'RICMapArg(%d, %d)';
737 Result := Format(fmtStr, [IMG_SYMB_MAP(val), IMG_SYMB_ARG(val)]);
738 end;
739 end;
740 end;
741 end;
742
RICPointToStrnull743 function RICPointToStr(const val : TImgPoint; const aLangName : TLangName) : string;
744 var
745 fmtStr : string;
746 begin
747 if aLangName in [lnNBC, lnNXC, lnNXCHeader] then
748 begin
749 if aLangName in [lnNBC, lnNXC] then
750 fmtStr := '%s, %s'
751 else
752 fmtStr := 'RICImgPoint(%s, %s)';
753 Result := Format(fmtStr,
754 [RICValueToStr(val.X, aLangName), RICValueToStr(val.Y, aLangName)]);
755 end
756 else
757 Result := '';
758 end;
759
RICRectToStrnull760 function RICRectToStr(const val : TImgRect; const aLangName : TLangName) : string;
761 var
762 fmtStr : string;
763 begin
764 if aLangName in [lnNBC, lnNXC, lnNXCHeader] then
765 begin
766 if aLangName in [lnNBC, lnNXC] then
767 fmtStr := '%s, %s, %s'
768 else
769 fmtStr := 'RICImgRect(%s, %s, %s)';
770 Result := Format(fmtStr,
771 [RICPointToStr(val.Pt, aLangName),
772 RICValueToStr(val.Width, aLangName),
773 RICValueToStr(val.Height, aLangName)]);
774 end
775 else
776 Result := '';
777 end;
778
ImgRectnull779 function ImgRect(X, Y, Width, Height: SmallInt): TImgRect;
780 begin
781 Result.Pt.X := X;
782 Result.Pt.Y := Y;
783 Result.Width := Width;
784 Result.Height := Height;
785 end;
786
ImgPointnull787 function ImgPoint(X, Y: SmallInt): TImgPoint;
788 begin
789 Result.X := X;
790 Result.Y := Y;
791 end;
792
793
RICToTextnull794 function RICToText(aMS : TMemoryStream; ops : TRICOps; const Filename : string) : string;
795 var
796 OpSize, i, j : integer;
797 tmpCmd, tmpRow : string;
798 DataSize : Cardinal;
799 pImage : PIMG_OP_UNION;
800 pCB : PIMG_OP_COPYBITS;
801 pL : PIMG_OP_LINE;
802 pR : PIMG_OP_RECT;
803 pC : PIMG_OP_CIRCLE;
804 pNB : PIMG_OP_NUMBOX;
805 pSP : PIMG_OP_SPRITE;
806 pVM : PIMG_OP_VARMAP;
807 pD : PIMG_OP_DESCRIPTION;
808 pPX : PIMG_OP_PIXEL;
809 pE : PIMG_OP_ELLIPSE;
810 pP : PIMG_OP_POLYGON;
811 pB : PByte;
812 pMAP : PIOV_MAPELT;
813 pImgPt : PIMG_PT;
814 theText : TStringList;
815 opDescr : TRICDescription;
816 opSprite : TRICSprite;
817 opVM : TRICVarMap;
818 opCB : TRICCopyBits;
819 opPixel : TRICPixel;
820 opLine : TRICLine;
821 opRect : TRICRect;
822 opCircle : TRICCircle;
823 opNumBox : TRICNumBox;
824 opEllipse : TRICEllipse;
825 opPolygon : TRICPolygon;
826 begin
827 ops.Clear;
828 Result := '';
829 theText := TStringList.Create;
830 try
831 DataSize := Cardinal(aMS.Size);
832 aMS.Position := 0;
833 pImage := aMS.Memory;
834 if Filename <> '' then
835 theText.Add(Format('// %s', [ExtractFileName(Filename)]));
836 // Run through the op codes.
837 while DataSize >= SizeOf(IMG_OP_CORE) do
838 begin
839 // Setup to look at an opcode, make sure it looks reasonable.
840 OpSize := pImage^.Core.OpSize + SizeOf(Word);
841 if (OpSize and $01) <> 0 then
842 Break; // Odd sizes not allowed.
843 case pImage^.Core.OpCode of
844 IMG_DESCRIPTION_ID : begin
845 if OpSize >= SizeOf(IMG_OP_DESCRIPTION) then
846 begin
847 // write out the Description opcode
848 pD := @(pImage^.Desc);
849 if pD^.Options = $8001 then
850 begin
851 theText.Add(Format('%s(%d, %d);',
852 [RICOpCodeToStr(pD^.OpCode, pD^.Options), pD^.Width, pD^.Height]));
853 end
854 else
855 begin
856 theText.Add(Format('%s(%d, %d, %d);',
857 [RICOpCodeToStr(pD^.OpCode), pD^.Options, pD^.Width, pD^.Height]));
858 end;
859 // add to the operations list
860 opDescr := TRICDescription.Create(ops);
861 with opDescr do begin
862 OpCode := pD^.OpCode;
863 OpSize := pD^.OpSize;
864 Options := pD^.Options;
865 Width := pD^.Width;
866 Height := pD^.Height;
867 end;
868 end;
869 end;
870 IMG_SPRITE_ID : begin
871 if OpSize >= SizeOf(IMG_OP_SPRITE) then
872 begin
873 // write the sprite to the file.
874 pSP := @(pImage^.Sprite);
875 // add to the operations list
876 opSprite := TRICSprite.Create(ops);
877 with opSprite do begin
878 OpCode := pSP^.OpCode;
879 OpSize := pSP^.OpSize;
880 DataAddr := pSP^.DataAddr;
881 Rows := pSP^.Rows;
882 RowBytes := pSP^.RowBytes;
883 end;
884 tmpCmd := Format('%s(%d', [RICOpCodeToStr(pSP^.OpCode), pSP^.DataAddr]);
885 pB := @(pSP^.Bytes[0]);
886 for j := 0 to pSP^.Rows - 1 do begin
887 tmpRow := '0x';
888 for i := 0 to pSP^.RowBytes - 1 do begin
889 // pB points at the current byte
890 tmpRow := tmpRow + SpriteByteToHexString(pB^);
891 opSprite.Add(pb^);
892 inc(pB);
893 end;
894 tmpCmd := tmpCmd + ', ' + tmpRow;
895 end;
896 tmpCmd := tmpCmd + ');';
897 theText.Add(tmpCmd);
898 // set the OpSize value last since adding bytes tries to change the OpSize value
899 opSprite.OpSize := pSP^.OpSize;
900 end;
901 end;
902 IMG_VARMAP_ID : begin
903 if OpSize >= SizeOf(IMG_OP_VARMAP) then
904 begin
905 // write the varmap to the file.
906 pVM := @(pImage^.VarMap);
907 // add to the operations list
908 opVM := TRICVarMap.Create(ops);
909 with opVM do begin
910 OpCode := pVM^.OpCode;
911 OpSize := pVM^.OpSize;
912 DataAddr := pVM^.DataAddr;
913 end;
914 tmpCmd := Format('%s(%d', [RICOpCodeToStr(pVM^.OpCode), pVM^.DataAddr]);
915 pMAP := @(pVM^.MapElt[0]);
916 for j := 0 to pVM^.MapCount - 1 do begin
917 tmpCmd := tmpCmd + Format(', f(%d)=%d', [pMAP^.Domain, pMAP^.Range]);
918 opVM.AddMap(pMAP);
919 inc(pMAP);
920 end;
921 tmpCmd := tmpCmd + ');';
922 theText.Add(tmpCmd);
923 // set the OpSize value last since adding map elements tries to change the OpSize value
924 opVM.OpSize := pVM^.OpSize;
925 end;
926 end;
927 IMG_COPYBITS_ID : begin
928 if OpSize >= SizeOf(IMG_OP_COPYBITS) then
929 begin
930 // write the CopyBits opcode to the file
931 pCB := @(pImage^.CopyBits);
932 // add to the operations list
933 opCB := TRICCopyBits.Create(ops);
934 with opCB do begin
935 OpCode := pCB^.OpCode;
936 OpSize := pCB^.OpSize;
937 CopyOptions := pCB^.CopyOptions;
938 DataAddr := pCB^.DataAddr;
939 SrcRect := ImgRect(pCB^.Src.Pt.X, pCB^.Src.Pt.Y, pCB^.Src.Width, pCB^.Src.Height);
940 DestPoint := ImgPoint(pCB^.Dst.X, pCB^.Dst.Y);
941 end;
942 theText.Add(Format('%s(%s, %s, %s, %s, %s, %s, %s, %s);',
943 [RICOpCodeToStr(pCB^.OpCode),
944 RICValueToStr(pCB^.CopyOptions), RICValueToStr(pCB^.DataAddr),
945 RICValueToStr(pCB^.Src.Pt.X), RICValueToStr(pCB^.Src.Pt.Y),
946 RICValueToStr(pCB^.Src.Width), RICValueToStr(pCB^.Src.Height),
947 RICValueToStr(pCB^.Dst.X), RICValueToStr(pCB^.Dst.Y)]));
948 end;
949 end;
950 IMG_PIXEL_ID : begin
951 if OpSize >= SizeOf(IMG_OP_PIXEL) then begin
952 pPX := @(pImage^.Pixel);
953 // add to the operations list
954 opPixel := TRICPixel.Create(ops);
955 with opPixel do begin
956 OpCode := pPX^.OpCode;
957 OpSize := pPX^.OpSize;
958 CopyOptions := pPX^.CopyOptions;
959 Point := ImgPoint(pPX^.Pt.X, pPX^.Pt.Y);
960 Value := pPX^.Value;
961 end;
962 theText.Add(Format('%s(%s, %s, %s, %s);',
963 [RICOpCodeToStr(pPX^.OpCode), RICValueToStr(pPX^.CopyOptions),
964 RICValueToStr(pPX^.Pt.X), RICValueToStr(pPX^.Pt.Y),
965 RICValueToStr(pPX^.Value)]));
966 end;
967 end;
968 IMG_LINE_ID : begin
969 if OpSize >= SizeOf(IMG_OP_LINE) then begin
970 pL := @(pImage^.Line);
971 // add to the operations list
972 opLine := TRICLine.Create(ops);
973 with opLine do begin
974 OpCode := pL^.OpCode;
975 OpSize := pL^.OpSize;
976 CopyOptions := pL^.CopyOptions;
977 Point1 := ImgPoint(pL^.Pt1.X, pL^.Pt1.Y);
978 Point2 := ImgPoint(pL^.Pt2.X, pL^.Pt2.Y);
979 end;
980 theText.Add(Format('%s(%s, %s, %s, %s, %s);',
981 [RICOpCodeToStr(pL^.OpCode), RICValueToStr(pL^.CopyOptions),
982 RICValueToStr(pL^.Pt1.X), RICValueToStr(pL^.Pt1.Y),
983 RICValueToStr(pL^.Pt2.X), RICValueToStr(pL^.Pt2.Y)]));
984 end;
985 end;
986 IMG_RECTANGLE_ID : begin
987 if OpSize >= SizeOf(IMG_OP_RECT) then begin
988 pR := @(pImage^.Rect);
989 // add to the operations list
990 opRect := TRICRect.Create(ops);
991 with opRect do begin
992 OpCode := pR^.OpCode;
993 OpSize := pR^.OpSize;
994 CopyOptions := pR^.CopyOptions;
995 Point := ImgPoint(pR^.Pt.X, pR^.Pt.Y);
996 Width := pR^.Width;
997 Height := pR^.Height;
998 end;
999 theText.Add(Format('%s(%s, %s, %s, %s, %s);',
1000 [RICOpCodeToStr(pR^.OpCode), RICValueToStr(pR^.CopyOptions),
1001 RICValueToStr(pR^.Pt.X), RICValueToStr(pR^.Pt.Y),
1002 RICValueToStr(pR^.Width), RICValueToStr(pR^.Height)]));
1003 end;
1004 end;
1005 IMG_CIRCLE_ID : begin
1006 if OpSize >= SizeOf(IMG_OP_CIRCLE) then begin
1007 pC := @(pImage^.Circle);
1008 // add to the operations list
1009 opCircle := TRICCircle.Create(ops);
1010 with opCircle do begin
1011 OpCode := pC^.OpCode;
1012 OpSize := pC^.OpSize;
1013 CopyOptions := pC^.CopyOptions;
1014 Point := ImgPoint(pC^.Pt.X, pC^.Pt.Y);
1015 Radius := pC^.Radius;
1016 end;
1017 theText.Add(Format('%s(%s, %s, %s, %s);',
1018 [RICOpCodeToStr(pC^.OpCode), RICValueToStr(pC^.CopyOptions),
1019 RICValueToStr(pC^.Pt.X), RICValueToStr(pC^.Pt.Y),
1020 RICValueToStr(pC^.Radius)]));
1021 end;
1022 end;
1023 IMG_NUMBOX_ID : begin
1024 if OpSize >= SizeOf(IMG_OP_NUMBOX) then begin
1025 pNB := @(pImage^.NumBox);
1026 // add to the operations list
1027 opNumBox := TRICNumBox.Create(ops);
1028 with opNumBox do begin
1029 OpCode := pNB^.OpCode;
1030 OpSize := pNB^.OpSize;
1031 CopyOptions := pNB^.CopyOptions;
1032 Point := ImgPoint(pNB^.Pt.X, pNB^.Pt.Y);
1033 Value := pNB^.Value;
1034 end;
1035 theText.Add(Format('%s(%s, %s, %s, %s);',
1036 [RICOpCodeToStr(pNB^.OpCode), RICValueToStr(pNB^.CopyOptions),
1037 RICValueToStr(pNB^.Pt.X), RICValueToStr(pNB^.Pt.Y),
1038 RICValueToStr(pNB^.Value)]));
1039 end;
1040 end;
1041 IMG_ELLIPSE_ID : begin
1042 if OpSize >= SizeOf(IMG_OP_ELLIPSE) then begin
1043 pE := @(pImage^.Ellipse);
1044 // add to the operations list
1045 opEllipse := TRICEllipse.Create(ops);
1046 with opEllipse do begin
1047 OpCode := pE^.OpCode;
1048 OpSize := pE^.OpSize;
1049 CopyOptions := pE^.CopyOptions;
1050 Point := ImgPoint(pE^.Pt.X, pE^.Pt.Y);
1051 Radius1 := pE^.Radius1;
1052 Radius2 := pE^.Radius2;
1053 end;
1054 theText.Add(Format('%s(%s, %s, %s, %s, %s);',
1055 [RICOpCodeToStr(pE^.OpCode), RICValueToStr(pE^.CopyOptions),
1056 RICValueToStr(pE^.Pt.X), RICValueToStr(pE^.Pt.Y),
1057 RICValueToStr(pE^.Radius1), RICValueToStr(pE^.Radius2)]));
1058 end;
1059 end;
1060 IMG_POLYGON_ID : begin
1061 if OpSize >= SizeOf(IMG_OP_POLYGON) then
1062 begin
1063 pP := @(pImage^.Polygon);
1064 // add to the operations list
1065 opPolygon := TRICPolygon.Create(ops);
1066 with opPolygon do begin
1067 OpCode := pP^.OpCode;
1068 OpSize := pP^.OpSize;
1069 CopyOptions := pP^.CopyOptions;
1070 end;
1071 tmpCmd := Format('%s(%s', [RICOpCodeToStr(pP^.OpCode), RICValueToStr(pP^.CopyOptions)]);
1072 pImgPt := @(pP^.Points[0]);
1073 for j := 0 to pP^.Count - 1 do begin
1074 tmpCmd := tmpCmd + Format(', (%d, %d)', [pImgPt^.X, pImgPt^.Y]);
1075 opPolygon.AddPoint(pImgPt);
1076 inc(pImgPt);
1077 end;
1078 tmpCmd := tmpCmd + ');';
1079 theText.Add(tmpCmd);
1080 // set the OpSize value last since adding polygon points tries to change the OpSize value
1081 opPolygon.OpSize := pP^.OpSize;
1082 end;
1083 end;
1084 else
1085 //Unrecognized opcode so quit
1086 Break;
1087 end;
1088 dec(DataSize, OpSize);
1089 pImage := PIMG_OP_UNION(PChar(pImage) + OpSize);
1090 end;
1091 Result := theText.Text;
1092 finally
1093 theText.Free;
1094 end;
1095 end;
1096
1097 { TRICComp }
1098
1099 constructor TRICComp.Create;
1100 begin
1101 inherited;
1102 fIncludeDirs := TStringList.Create;
1103 fMessages := TStringList.Create;
1104 fMS := TMemoryStream.Create;
1105 fOperations := TRICOps.Create;
1106 fCurFile := '';
1107 fOptimize := False;
1108 fMaxErrors := 0;
1109 fCalc := TExpParser.Create(nil);
1110 fCalc.CaseSensitive := True;
1111 fFirmwareVersion := 128; // 1.28 NXT 2.0 firmware
1112 end;
1113
1114 destructor TRICComp.Destroy;
1115 begin
1116 FreeAndNil(fIncludeDirs);
1117 FreeAndNil(fMessages);
1118 FreeAndNil(fMS);
1119 FreeAndNil(fOperations);
1120 FreeAndNil(fCalc);
1121 inherited;
1122 end;
1123
1124 {
1125 procedure TRICComp.Draw(aPoint: TImgPoint; Vars: TRICVariables;
1126 Options: Cardinal; aCanvas: TImgCanvas);
1127 begin
1128 fOperations.Draw(aPoint, Vars, Options, aCanvas);
1129 end;
1130 }
1131
TRICComp.GetAsTextnull1132 function TRICComp.GetAsText: string;
1133 begin
1134 // make sure the stream matches the contents of fOperations
1135 SyncStreamToObjectList;
1136 Result := uRICComp.RICToText(fMS, fOperations, fCurFile);
1137 end;
1138
GetOperationnull1139 function TRICComp.GetOperation(Index: integer): TRICOpBase;
1140 begin
1141 Result := TRICOpBase(fOperations[Index]);
1142 end;
1143
TRICComp.GetOpCountnull1144 function TRICComp.GetOpCount: Integer;
1145 begin
1146 Result := fOperations.Count;
1147 end;
1148
1149 procedure TRICComp.LoadFromFile(const aFilename: string);
1150 var
1151 Stream: TStream;
1152 begin
1153 fCurFile := aFilename;
1154 Stream := TFileStream.Create(aFilename, fmOpenRead or fmShareDenyWrite);
1155 try
1156 LoadFromStream(Stream);
1157 finally
1158 Stream.Free;
1159 end;
1160 end;
1161
1162 procedure TRICComp.LoadFromStream(aStream: TStream);
1163 begin
1164 fMS.LoadFromStream(aStream);
1165 SyncObjectListToStream;
1166 end;
1167
TRICComp.RICToTextnull1168 class function TRICComp.RICToText(aStream: TStream; const aFilename : string): string;
1169 begin
1170 with TRICComp.Create do
1171 try
1172 fCurFile := aFilename;
1173 LoadFromStream(aStream);
1174 Result := AsText;
1175 finally
1176 Free;
1177 end;
1178 end;
1179
TRICComp.RICToTextnull1180 class function TRICComp.RICToText(const aFilename: string): string;
1181 begin
1182 with TRICComp.Create do
1183 try
1184 LoadFromFile(aFilename);
1185 Result := AsText;
1186 finally
1187 Free;
1188 end;
1189 end;
1190
1191 procedure TRICComp.SaveToFile(const aFilename: string);
1192 var
1193 Stream: TStream;
1194 begin
1195 Stream := TFileStream.Create(aFilename, fmCreate);
1196 try
1197 SaveToStream(Stream);
1198 finally
1199 Stream.Free;
1200 end;
1201 end;
1202
1203 procedure TRICComp.SaveToStream(aStream: TStream);
1204 begin
1205 SyncStreamToObjectlist;
1206 aStream.CopyFrom(fMS, 0);
1207 end;
1208
1209 procedure TRICComp.SetAsText(const Value: string);
1210 var
1211 SL : TStringList;
1212 begin
1213 Clear;
1214 // compile text to RIC
1215 SL := TStringList.Create;
1216 try
1217 SL.Text := Value;
1218 SL.SaveToStream(fMS);
1219 InternalParseStream;
1220 finally
1221 SL.Free;
1222 end;
1223 end;
1224
1225 procedure TRICComp.ReportProblem(const lineNo: integer; const fName,
1226 msg: string; err : boolean);
1227 var
1228 tmp, tmp1, tmp2, tmp3, tmp4 : string;
1229 stop : boolean;
1230 begin
1231 if lineNo = -1 then
1232 begin
1233 tmp := msg;
1234 fMessages.Add(tmp);
1235 end
1236 else
1237 begin
1238 if err then
1239 tmp1 := Format('# Error: %s', [msg])
1240 else
1241 tmp1 := Format('# Warning: %s', [msg]);
1242 fMessages.Add(tmp1);
1243 tmp2 := Format('File "%s" ; line %d', [fName, lineNo]);
1244 fMessages.Add(tmp2);
1245 tmp3 := Format('# %s', [fCurrentLine]);
1246 fMessages.Add(tmp3);
1247 tmp4 := '#----------------------------------------------------------';
1248 fMessages.Add(tmp4);
1249 tmp := tmp1+#13#10+tmp2+#13#10+tmp3+#13#10+tmp4;
1250 end;
1251 fBadProgram := err;
1252 if err then
1253 inc(fProgErrorCount);
1254 stop := (MaxErrors > 0) and (fProgErrorCount >= MaxErrors);
1255 // stop := false;
1256 if assigned(fOnCompMsg) then
1257 fOnCompMsg(tmp, stop);
1258 if stop then
1259 Abort;
1260 end;
1261
1262 procedure TRICComp.IncLineNumber;
1263 begin
1264 linenumber := linenumber + 1;
1265 inc(totallines);
1266 end;
1267
1268 procedure TRICComp.GetCharX;
1269 var
1270 bytesread : integer;
1271 begin
1272 bytesread := fMS.Read(Look, 1);
1273 inc(fBytesRead, bytesread);
1274 fCurrentLine := fCurrentLine + Look;
1275 if Look = LF then
1276 begin
1277 IncLineNumber;
1278 fCurrentLine := '';
1279 end;
1280 if bytesread < 1 then
1281 endofallsource := True;
1282 if endofallsource and (slevel > 1) then begin
1283 // close file pointer
1284 linenumber := 0;
1285 dec(slevel);
1286 Look := LF;
1287 endofallsource := False;
1288 end;
1289 end;
1290
1291 procedure TRICComp.GetChar;
1292 begin
1293 if fTempChar <> ' ' then begin
1294 Look := fTempChar;
1295 fCurrentLine := fCurrentLine + Look;
1296 fTempChar := ' ';
1297 end
1298 else begin
1299 GetCharX;
1300 if Look = '/' then begin
1301 fMS.Read(fTempChar, 1);
1302 if fTempChar = '*' then begin
1303 Look := TOK_BLOCK_COMMENT;
1304 fTempChar := ' ';
1305 end
1306 else if fTempChar = '/' then begin
1307 Look := TOK_LINE_COMMENT;
1308 fTempChar := ' ';
1309 end;
1310 end;
1311 end;
1312 end;
1313
IsWhitenull1314 function TRICComp.IsWhite(c: char): boolean;
1315 begin
1316 Result := c in [' ', TAB, CR, LF, TOK_BLOCK_COMMENT, TOK_LINE_COMMENT];
1317 end;
1318
TRICComp.IsAlphanull1319 function TRICComp.IsAlpha(c: char): boolean;
1320 begin
1321 Result := c in ['A'..'Z', 'a'..'z', '_'];
1322 end;
1323
IsDigitnull1324 function TRICComp.IsDigit(c: char): boolean;
1325 begin
1326 Result := c in ['0'..'9'];
1327 end;
1328
TRICComp.IsHexnull1329 function TRICComp.IsHex(c: char): boolean;
1330 begin
1331 Result := IsDigit(c) or (c in ['a'..'f', 'A'..'F']);
1332 end;
1333
TRICComp.IsAlNumnull1334 function TRICComp.IsAlNum(c: char): boolean;
1335 begin
1336 Result := IsAlpha(c) or IsDigit(c) or (c = '.');
1337 end;
1338
1339 procedure TRICComp.SkipCommentBlock;
1340 begin
1341 repeat
1342 repeat
1343 GetCharX;
1344 until (Look = '*') or endofallsource;
1345 GetCharX;
1346 until (Look = '/') or endofallsource;
1347 GetChar;
1348 end;
1349
1350 procedure TRICComp.SkipLine;
1351 begin
1352 repeat
1353 GetCharX;
1354 until (Look = LF) or endofallsource;
1355 GetChar;
1356 end;
1357
1358 procedure TRICComp.SkipWhite;
1359 begin
1360 while IsWhite(Look) and not endofallsource do begin
1361 case Look of
1362 TOK_LINE_COMMENT : SkipLine;
1363 TOK_BLOCK_COMMENT : SkipCommentBlock;
1364 else
1365 GetChar;
1366 end;
1367 end;
1368 end;
1369
1370 procedure TRICComp.AbortMsg(s: string);
1371 begin
1372 ReportProblem(linenumber, CurrentFile, s, True);
1373 end;
1374
1375 procedure TRICComp.Expected(s: string);
1376 begin
1377 AbortMsg(Format(sExpectedString, [s]));
1378 end;
1379
1380 procedure TRICComp.GetName;
1381 begin
1382 SkipWhite;
1383 if not IsAlpha(Look) then Expected(sIdentifier);
1384 Token := TOK_IDENTIFIER;
1385 Value := '';
1386 repeat
1387 Value := Value + Look;
1388 GetChar;
1389 until not IsAlNum(Look);
1390 end;
1391
1392 procedure TRICComp.GetNum;
1393 var
1394 savedLook : char;
1395 begin
1396 SkipWhite;
1397 if not IsDigit(Look) then Expected(sNumber);
1398 savedLook := Look;
1399 GetChar;
1400 if Look in ['x', 'X'] then
1401 begin
1402 GetHexNum;
1403 end
1404 else
1405 begin
1406 Token := TOK_NUM;
1407 Value := savedLook;
1408 if not IsDigit(Look) then Exit;
1409 repeat
1410 Value := Value + Look;
1411 GetChar;
1412 until not IsDigit(Look);
1413 end;
1414 end;
1415
1416 procedure TRICComp.GetHexNum;
1417 begin
1418 SkipWhite;
1419 GetChar(); // skip the $ (or 'x')
1420 if not IsHex(Look) then Expected(sHexNumber);
1421 Token := TOK_HEX;
1422 Value := '0x';
1423 repeat
1424 Value := Value + Look;
1425 GetChar;
1426 until not IsHex(Look);
1427 end;
1428
1429 procedure TRICComp.GetOp;
1430 begin
1431 SkipWhite;
1432 Token := Look;
1433 Value := Look;
1434 GetChar;
1435 end;
1436
1437 procedure TRICComp.GetString;
1438 begin
1439 SkipWhite;
1440 GetChar; // skip the "
1441 Token := TOK_STRINGLIT;
1442 if Look = '"' then
1443 begin
1444 // empty string
1445 Value := '''''';
1446 GetChar;
1447 end
1448 else
1449 begin
1450 Value := '''' + Look;
1451 repeat
1452 GetCharX;
1453 if (Look <> LF) and (Look <> '"') then
1454 begin
1455 if Look = '''' then
1456 Value := Value + '"'
1457 else
1458 Value := Value + Look;
1459 end;
1460 until (Look = '"') or (Look = LF) or endofallsource;
1461 Value := Value + '''';
1462 if Look <> '"' then Expected(sStringLiteral);
1463 GetChar;
1464 end;
1465 end;
1466
1467 procedure TRICComp.Next;
1468 begin
1469 SkipWhite;
1470 if Look = '"' then GetString
1471 else if IsAlpha(Look) then GetName
1472 else if IsDigit(Look) then GetNum
1473 else if Look = '$' then GetHexNum
1474 else GetOp;
1475 end;
1476
1477
1478 procedure TRICComp.Init;
1479 begin
1480 fCurrentLine := '';
1481 totallines := 1;
1482 linenumber := 1;
1483 GetChar;
1484 Next;
1485 while (Token = #0) and not endofallsource do
1486 Next;
1487 end;
1488
Lookupnull1489 function Lookup(T: TabPtr; s: string; n: integer): integer;
1490 var
1491 i: integer;
1492 found: Boolean;
1493 begin
1494 found := false;
1495 i := n;
1496 while (i > 0) and not found do
1497 if s = T^[i] then
1498 found := true
1499 else
1500 dec(i);
1501 Result := i;
1502 end;
1503
1504 procedure TRICComp.Scan;
1505 var
1506 idx : integer;
1507 begin
1508 if Token = TOK_IDENTIFIER then
1509 begin
1510 idx := Lookup(Addr(KWlist), Value, NKW);
1511 if idx <> 0 then
1512 Token := KWcode[idx + 1];
1513 end;
1514 end;
1515
1516 procedure TRICComp.CheckBytesRead(const oldBytesRead: integer);
1517 begin
1518 if fBytesRead = oldBytesRead then
1519 begin
1520 AbortMsg(sParserError);
1521 SkipLine;
1522 Next;
1523 end;
1524 end;
1525
1526 procedure TRICComp.MatchString(x: string);
1527 begin
1528 if Value <> x then Expected('''' + x + '''');
1529 Next;
1530 end;
1531
1532 procedure TRICComp.CheckNumeric;
1533 begin
1534 if not (Token in [TOK_NUM, TOK_HEX]) then Expected(sNumber);
1535 end;
1536
1537 procedure TRICComp.CheckStringConst;
1538 begin
1539 if (Token <> TOK_STRINGLIT) then
1540 Expected(sStringLiteral);
1541 end;
1542
1543 procedure TRICComp.Semi;
1544 begin
1545 MatchString(';');
1546 end;
1547
1548 procedure TRICComp.OpenParen;
1549 begin
1550 MatchString(TOK_OPENPAREN);
1551 inc(fParenDepth);
1552 end;
1553
1554 procedure TRICComp.CloseParen;
1555 begin
1556 dec(fParenDepth);
1557 if fParenDepth < 0 then
1558 AbortMsg(sUnmatchedCloseParen);
1559 MatchString(TOK_CLOSEPAREN);
1560 end;
1561
TRICComp.StringToIntnull1562 function TRICComp.StringToInt(const val : string) : integer;
1563 begin
1564 Result := 0;
1565 fCalc.SilentExpression := val;
1566 if not fCalc.ParserError then
1567 Result := Integer(Trunc(fCalc.Value))
1568 else
1569 AbortMsg(sInvalidConstExpr);
1570 end;
1571
TRICComp.ValueToIntnull1572 function TRICComp.ValueToInt : integer;
1573 begin
1574 Result := StringToInt(Value);
1575 end;
1576
TRICComp.ValueToSmallIntnull1577 function TRICComp.ValueToSmallInt : SmallInt;
1578 begin
1579 Result := SmallInt(ValueToInt);
1580 end;
1581
ValueToWordnull1582 function TRICComp.ValueToWord : Word;
1583 begin
1584 Result := Word(ValueToInt);
1585 end;
1586
ProcessWordArgnull1587 function TRICComp.ProcessWordArg : Word;
1588 begin
1589 Result := Word(ProcessArg);
1590 end;
1591
TRICComp.ProcessArgnull1592 function TRICComp.ProcessArg : SmallInt;
1593 var
1594 mapidx : SmallInt;
1595 begin
1596 Result := 0;
1597 {
1598 arg can be a simple numeric value: 0x12, 32, or $f
1599 or a parameterized argument: arg(0x12), arg(32), arg($f)
1600 or a parameterized & mapped argument: maparg(0x1, 0x12), maparg(1, 23), etc...
1601 }
1602 case Token of
1603 TOK_ARG : begin
1604 // arg(value)
1605 Next;
1606 MatchString(TOK_OPENPAREN);
1607 CheckNumeric;
1608 Result := ValueToSmallInt;
1609 if (Result < 0) or
1610 (EnhancedFirmware and (Result > $ff)) or
1611 (not EnhancedFirmware and (Result > $f))then
1612 AbortMsg(Format(sInvalidArgument, [Result]));
1613 Result := Result or USEARGS_MASK;
1614 Next;
1615 // leave it pointing at the close paren
1616 end;
1617 TOK_MAPARG : begin
1618 // maparg(value, value)
1619 Next;
1620 MatchString(TOK_OPENPAREN);
1621 CheckNumeric;
1622 mapidx := ValueToSmallInt;
1623 if (mapidx < 0) or (mapidx > $a) then
1624 AbortMsg(Format(sInvalidVarMapIndex, [mapidx]));
1625 Next;
1626 MatchString(TOK_COMMA);
1627 Result := ValueToSmallInt;
1628 if (Result < 0) or
1629 (EnhancedFirmware and (Result > $ff)) or
1630 (not EnhancedFirmware and (Result > $f))then
1631 AbortMsg(Format(sInvalidArgument, [Result]));
1632 Result := Result or SmallInt((mapidx and $f) shl 8);
1633 Result := Result or USEARGS_MASK;
1634 Next;
1635 // leave it pointing at the close paren
1636 end;
1637 TOK_NUM, TOK_HEX : begin
1638 Result := ValueToSmallInt;
1639 end;
1640 else
1641 AbortMsg(sInvalidCommandArgument);
1642 end;
1643 end;
1644
1645 procedure TRICComp.DoDesc;
1646 var
1647 op : TRICDescription;
1648 begin
1649 // add a description opcode
1650 op := TRICDescription.Create(RICOps);
1651 // parse and set its values
1652 // desc(options, width, height);
1653 Next;
1654 OpenParen;
1655 CheckNumeric;
1656 op.Options := ValueToWord;
1657 Next;
1658 MatchString(TOK_COMMA);
1659 CheckNumeric;
1660 op.Width := ValueToWord;
1661 Next;
1662 MatchString(TOK_COMMA);
1663 CheckNumeric;
1664 op.Height := ValueToWord;
1665 Next;
1666 CloseParen;
1667 end;
1668
1669 procedure TRICComp.DoSprite;
1670 var
1671 op : TRICSprite;
1672 sl : TStringList;
1673 i : integer;
1674 bFileFound : boolean;
1675 fname, usePath : string;
1676 thresh, width, height : integer;
1677 const
1678 DEF_SPRITE_IMPORT_THRESHOLD = 50;
1679 DEF_SPRITE_IMPORT_WIDTH = 100;
1680 DEF_SPRITE_IMPORT_HEIGHT = 64;
1681 begin
1682 // add a sprite opcode
1683 op := TRICSprite.Create(RICOps);
1684 // parse and set its values
1685 // sprite(addr, row1, row2, ..., rowN);
1686 // sprite(addr, import("filename.ext"[, threshold]));
1687 // sprite(addr, import("filename.ext"[, threshold, width, height]));
1688 Next;
1689 OpenParen;
1690 CheckNumeric;
1691 op.DataAddr := ValueToWord;
1692 Next;
1693 MatchString(TOK_COMMA);
1694 scan;
1695 if Token = TOK_IMPORT then begin
1696 // support "import" keyword
1697 thresh := DEF_SPRITE_IMPORT_THRESHOLD;
1698 width := DEF_SPRITE_IMPORT_WIDTH;
1699 height := DEF_SPRITE_IMPORT_HEIGHT;
1700 Next;
1701 OpenParen;
1702 CheckStringConst;
1703 fname := Value;
1704 Next;
1705 if Token = TOK_COMMA then begin
1706 MatchString(TOK_COMMA);
1707 // optional threshold value
1708 CheckNumeric;
1709 thresh := StrToIntDef(Value, thresh);
1710 Next;
1711 if Token = TOK_COMMA then begin
1712 MatchString(TOK_COMMA);
1713 // optional width & height
1714 CheckNumeric;
1715 width := StrToIntDef(Value, width);
1716 Next;
1717 MatchString(TOK_COMMA);
1718 CheckNumeric;
1719 height := StrToIntDef(Value, height);
1720 Next;
1721 end;
1722 end;
1723 CloseParen;
1724 CloseParen;
1725 // build sprite bytes using fname and thresh
1726 // find sprite file
1727 fName := StripQuotes(fName);
1728 usePath := '';
1729 bFileFound := FileExists(fname);
1730 if not bFileFound then
1731 begin
1732 for i := 0 to IncludeDirs.Count - 1 do
1733 begin
1734 usePath := IncludeTrailingPathDelimiter(IncludeDirs[i]);
1735 bFileFound := FileExists(usePath+fname);
1736 if bFileFound then Break;
1737 end;
1738 end;
1739 if bFileFound then
1740 begin
1741 ImportImage(op, usePath+fname, thresh, width, height);
1742 end
1743 else
1744 AbortMsg(Format(sUnableToFindImage, [fname]));
1745 end
1746 else
1747 begin
1748 sl := TStringList.Create;
1749 try
1750 while (Token <> TOK_CLOSEPAREN) and not endofallsource do
1751 begin
1752 sl.Add(Value + '=' + IntToStr(linenumber));
1753 Next;
1754 if Token = TOK_COMMA then
1755 MatchString(TOK_COMMA);
1756 end;
1757 CloseParen;
1758 // process strings in sl
1759 // calculate rows and rowbytes
1760 op.Rows := Word(sl.Count);
1761 if sl.count = 0 then
1762 begin
1763 op.RowBytes := 0;
1764 AbortMsg(sSpriteLengthError);
1765 end
1766 else
1767 op.RowBytes := op.CountBytes(sl.Names[0]);
1768 for i := 0 to sl.Count - 1 do
1769 begin
1770 // add bytes to Sprite for each line in sl
1771 try
1772 op.AddBytes(sl.Names[i]);
1773 except
1774 on E : Exception do
1775 AbortMsg(E.Message);
1776 end;
1777 end;
1778 finally
1779 sl.Free;
1780 end;
1781 end;
1782 if ((op.Rows*op.RowBytes) mod 2) = 1 then
1783 op.Add(0); // padding byte
1784 end;
1785
1786 procedure TRICComp.DoVarMap;
1787 var
1788 op : TRICVarMap;
1789 ME : TMapElement;
1790 begin
1791 // add a varmap opcode
1792 op := TRICVarMap.Create(RICOps);
1793 // parse and set its values
1794 // varmap(addr, func1, func2, ..., funcN);
1795 // where funcN is f(xval)=yval
1796 Next;
1797 OpenParen;
1798 CheckNumeric;
1799 op.DataAddr := ValueToWord;
1800 Next;
1801 MatchString(TOK_COMMA);
1802 while (Token <> TOK_CLOSEPAREN) and not endofallsource do
1803 begin
1804 // f(x)=y
1805 Scan;
1806 if Token <> TOK_F then
1807 AbortMsg(sInvalidMapSyntax);
1808 Next; // advance to open parenthesis
1809 OpenParen; // advance to x value
1810 ME := op.Add;
1811 CheckNumeric;
1812 ME.Domain := ValueToWord;
1813 Next; // advance to close parenthesis
1814 CloseParen; // advance to equal sign
1815 MatchString('=');
1816 // Next; // advance to y value
1817 CheckNumeric;
1818 ME.Range := ValueToWord;
1819 Next; // advance to comma or close paren
1820 if Token = TOK_COMMA then
1821 MatchString(TOK_COMMA);
1822 end;
1823 CloseParen;
1824 if op.MapCount < 2 then
1825 AbortMsg(sVarMapCountError);
1826 end;
1827
1828 procedure TRICComp.DoCopyBits;
1829 var
1830 op : TRICCopyBits;
1831 SR : TImgRect;
1832 DP : TImgPoint;
1833 begin
1834 // add a copybits opcode
1835 op := TRICCopyBits.Create(RICOps);
1836 // parse and set its values
1837 // copybits(options, dataaddr, srcx, srcy, srcw, srch, destx, desty);
1838 Next;
1839 OpenParen;
1840 Scan;
1841 op.CopyOptions := ProcessWordArg;
1842 Next;
1843 MatchString(TOK_COMMA);
1844 Scan;
1845 op.DataAddr := ProcessWordArg;
1846 Next;
1847 MatchString(TOK_COMMA);
1848 Scan;
1849 SR.Pt.X := ProcessArg;
1850 Next;
1851 MatchString(TOK_COMMA);
1852 Scan;
1853 SR.Pt.Y := ProcessArg;
1854 Next;
1855 MatchString(TOK_COMMA);
1856 Scan;
1857 SR.Width := ProcessArg;
1858 Next;
1859 MatchString(TOK_COMMA);
1860 Scan;
1861 SR.Height := ProcessArg;
1862 Next;
1863 MatchString(TOK_COMMA);
1864 Scan;
1865 op.SrcRect := SR;
1866 DP.X := ProcessArg;
1867 Next;
1868 MatchString(TOK_COMMA);
1869 Scan;
1870 DP.Y := ProcessArg;
1871 Next;
1872 CloseParen;
1873 op.DestPoint := DP;
1874 end;
1875
1876 procedure TRICComp.DoLine;
1877 var
1878 op : TRICLine;
1879 P1, P2 : TImgPoint;
1880 begin
1881 // add a line opcode
1882 op := TRICLine.Create(RICOps);
1883 // parse and set its values
1884 // line(options, p1x, p1y, p2x, p2y);
1885 Next;
1886 OpenParen;
1887 Scan;
1888 op.CopyOptions := ProcessWordArg;
1889 Next;
1890 MatchString(TOK_COMMA);
1891 Scan;
1892 P1.X := ProcessArg;
1893 Next;
1894 MatchString(TOK_COMMA);
1895 Scan;
1896 P1.Y := ProcessArg;
1897 Next;
1898 MatchString(TOK_COMMA);
1899 Scan;
1900 P2.X := ProcessArg;
1901 Next;
1902 MatchString(TOK_COMMA);
1903 Scan;
1904 P2.Y := ProcessArg;
1905 Next;
1906 CloseParen;
1907 op.Point1 := P1;
1908 op.Point2 := P2;
1909 end;
1910
1911 procedure TRICComp.DoRect;
1912 var
1913 op : TRICRect;
1914 P : TImgPoint;
1915 begin
1916 // add a rect opcode
1917 op := TRICRect.Create(RICOps);
1918 // parse and set its values
1919 // rect(options, x, y, w, h);
1920 Next;
1921 OpenParen;
1922 Scan;
1923 op.CopyOptions := ProcessWordArg;
1924 Next;
1925 MatchString(TOK_COMMA);
1926 Scan;
1927 P.X := ProcessArg;
1928 Next;
1929 MatchString(TOK_COMMA);
1930 Scan;
1931 P.Y := ProcessArg;
1932 Next;
1933 MatchString(TOK_COMMA);
1934 Scan;
1935 op.Point := P;
1936 op.Width := ProcessArg;
1937 Next;
1938 MatchString(TOK_COMMA);
1939 Scan;
1940 op.Height := ProcessArg;
1941 Next;
1942 CloseParen;
1943 end;
1944
1945 procedure TRICComp.DoPixel;
1946 var
1947 op : TRICPixel;
1948 P : TImgPoint;
1949 begin
1950 // add a pixel opcode
1951 op := TRICPixel.Create(RICOps);
1952 // parse and set its values
1953 // pixel(options, x, y, value);
1954 Next;
1955 OpenParen;
1956 Scan;
1957 op.CopyOptions := ProcessWordArg;
1958 Next;
1959 MatchString(TOK_COMMA);
1960 Scan;
1961 P.X := ProcessArg;
1962 Next;
1963 MatchString(TOK_COMMA);
1964 Scan;
1965 P.Y := ProcessArg;
1966 Next;
1967 MatchString(TOK_COMMA);
1968 Scan;
1969 op.Point := P;
1970 op.Value := ProcessWordArg;
1971 Next;
1972 CloseParen;
1973 end;
1974
1975 procedure TRICComp.DoCircle;
1976 var
1977 op : TRICCircle;
1978 P : TImgPoint;
1979 begin
1980 // add a circle opcode
1981 op := TRICCircle.Create(RICOps);
1982 // parse and set its values
1983 // circle(options, x, y, radius);
1984 Next;
1985 OpenParen;
1986 Scan;
1987 op.CopyOptions := ProcessWordArg;
1988 Next;
1989 MatchString(TOK_COMMA);
1990 Scan;
1991 P.X := ProcessArg;
1992 Next;
1993 MatchString(TOK_COMMA);
1994 Scan;
1995 P.Y := ProcessArg;
1996 Next;
1997 MatchString(TOK_COMMA);
1998 Scan;
1999 op.Point := P;
2000 op.Radius := ProcessWordArg;
2001 Next;
2002 CloseParen;
2003 end;
2004
2005 procedure TRICComp.DoEllipse;
2006 var
2007 op : TRICEllipse;
2008 P : TImgPoint;
2009 begin
2010 CheckFirmwareVersion(127, sEllipseRequires127);
2011 // add an ellipse opcode
2012 op := TRICEllipse.Create(RICOps);
2013 // parse and set its values
2014 // ellipse(options, x, y, radius1, radius2);
2015 Next;
2016 OpenParen;
2017 Scan;
2018 op.CopyOptions := ProcessWordArg;
2019 Next;
2020 MatchString(TOK_COMMA);
2021 Scan;
2022 P.X := ProcessArg;
2023 Next;
2024 MatchString(TOK_COMMA);
2025 Scan;
2026 P.Y := ProcessArg;
2027 Next;
2028 MatchString(TOK_COMMA);
2029 Scan;
2030 op.Point := P;
2031 op.Radius1 := ProcessWordArg;
2032 Next;
2033 MatchString(TOK_COMMA);
2034 Scan;
2035 op.Radius2 := ProcessWordArg;
2036 Next;
2037 CloseParen;
2038 end;
2039
2040 procedure TRICComp.DoPolygon;
2041 var
2042 op : TRICPolygon;
2043 PP : TPolyPoint;
2044 begin
2045 CheckFirmwareVersion(127, sPolygonRequires127);
2046 // add a polygon opcode
2047 op := TRICPolygon.Create(RICOps);
2048 // parse and set its values
2049 // polygon(options, coord1, coord2, ..., coordN);
2050 // where coordN is (xval, yval)
2051 Next;
2052 OpenParen;
2053 Scan;
2054 op.CopyOptions := ProcessWordArg;
2055 Next;
2056 MatchString(TOK_COMMA);
2057 while (Token <> TOK_CLOSEPAREN) and not endofallsource do
2058 begin
2059 // (x, y)
2060 OpenParen; // advance to x value
2061 PP := op.Add;
2062 Scan;
2063 PP.X := ProcessWordArg;
2064 Next; // advance to comma
2065 MatchString(',');
2066 Scan;
2067 PP.Y := ProcessWordArg;
2068 Next;
2069 CloseParen; // advance to close paren or comma
2070 if Token = TOK_COMMA then
2071 MatchString(TOK_COMMA);
2072 end;
2073 CloseParen;
2074 if op.Count < 3 then
2075 AbortMsg(sPolygonCountError);
2076 end;
2077
2078 procedure TRICComp.DoNumBox;
2079 var
2080 op : TRICNumBox;
2081 P : TImgPoint;
2082 begin
2083 // add a numbox opcode
2084 op := TRICNumBox.Create(RICOps);
2085 // parse and set its values
2086 // numbox(options, x, y, value);
2087 Next;
2088 OpenParen;
2089 Scan;
2090 op.CopyOptions := ProcessWordArg;
2091 Next;
2092 MatchString(TOK_COMMA);
2093 Scan;
2094 P.X := ProcessArg;
2095 Next;
2096 MatchString(TOK_COMMA);
2097 Scan;
2098 P.Y := ProcessArg;
2099 Next;
2100 MatchString(TOK_COMMA);
2101 Scan;
2102 op.Point := P;
2103 op.Value := ProcessWordArg;
2104 Next;
2105 CloseParen;
2106 end;
2107
2108 procedure TRICComp.Statement;
2109 begin
2110 case Token of
2111 TOK_DESC: DoDesc;
2112 TOK_SPRITE: DoSprite;
2113 TOK_VARMAP: DoVarMap;
2114 TOK_COPYBITS: DoCopyBits;
2115 TOK_LINE: DoLine;
2116 TOK_RECT: DoRect;
2117 TOK_PIXEL: DoPixel;
2118 TOK_CIRCLE: DoCircle;
2119 TOK_NUMBOX: DoNumBox;
2120 TOK_ELLIPSE: DoEllipse;
2121 TOK_POLYGON: DoPolygon;
2122 TOK_FONTOUT: DoFontOut;
2123 TOK_CLOSEPAREN : CloseParen;
2124 ';' : ;// do nothing
2125 end;
2126 end;
2127
2128 procedure TRICComp.ScriptCommands;
2129 var
2130 oldBytesRead : integer;
2131 begin
2132 Scan;
2133 while not endofallsource do
2134 begin
2135 oldBytesRead := fBytesRead;
2136 Statement;
2137 Semi;
2138 Scan;
2139 CheckBytesRead(oldBytesRead);
2140 end;
2141 end;
2142
2143 procedure TRICComp.InternalParseStream;
2144 begin
2145 try
2146 fBadProgram := False;
2147 fBytesRead := 0;
2148 fProgErrorCount := 0;
2149 fMS.Position := 0;
2150 fParenDepth := 0;
2151 Init;
2152 ScriptCommands;
2153 except
2154 on E : EAbort do
2155 begin
2156 fBadProgram := True;
2157 // end processing file due to Abort in ReportProblem
2158 end;
2159 on E : Exception do
2160 begin
2161 fBadProgram := True;
2162 ReportProblem(linenumber, CurrentFile, E.Message, true);
2163 end;
2164 end;
2165 end;
2166
2167 procedure TRICComp.SyncObjectListToStream;
2168 begin
2169 uRICComp.RICToText(fMS, fOperations, fCurFile);
2170 end;
2171
2172 procedure TRICComp.SyncStreamToObjectList;
2173 var
2174 i : integer;
2175 begin
2176 fMS.Clear;
2177 for i := 0 to fOperations.Count - 1 do
2178 TRICOpBase(fOperations[i]).SaveToStream(fMS);
2179 end;
2180
2181 procedure TRICComp.Parse(aStream: TStream);
2182 begin
2183 Clear;
2184 fMS.CopyFrom(aStream, 0);
2185 InternalParseStream;
2186 end;
2187
2188 procedure TRICComp.Parse(aStrings: TStrings);
2189 begin
2190 Clear;
2191 aStrings.SaveToStream(fMS);
2192 InternalParseStream;
2193 end;
2194
2195 procedure TRICComp.Parse(const aFilename: string);
2196 var
2197 Stream : TFileStream;
2198 begin
2199 Clear;
2200 Stream := TFileStream.Create(aFilename, fmOpenRead or fmShareDenyWrite);
2201 try
2202 fMS.CopyFrom(Stream, 0);
2203 finally
2204 Stream.Free;
2205 end;
2206 InternalParseStream;
2207 end;
2208
2209 procedure TRICComp.Clear;
2210 begin
2211 fMS.Clear;
2212 fMessages.Clear;
2213 fTempChar := ' ';
2214 end;
2215
TRICComp.SaveAsDataArraynull2216 function TRICComp.SaveAsDataArray(const aLangName: TLangName; varname : string): string;
2217 var
2218 tmp : string;
2219 i : integer;
2220 begin
2221 if varname = '' then
2222 varname := ChangeFileExt(ExtractFileName(CurrentFile),'')
2223 else
2224 varname := Format(varname, [ChangeFileExt(ExtractFileName(CurrentFile),'')]);
2225 if aLangName in [lnNXC, lnNXCHeader] then
2226 begin
2227 Result := 'byte ' + varname + '[] = {'#13#10;
2228 for i := 0 to fOperations.Count - 1 do
2229 begin
2230 Result := Result + TRICOpBase(fOperations[i]).SaveAsDataArray(aLangName);
2231 if i < fOperations.Count - 1 then
2232 Result := Result + ', ';
2233 Result := Result + #13#10;
2234 end;
2235 Result := Result + '};';
2236 end
2237 else if aLangName = lnNBC then
2238 begin
2239 tmp := '';
2240 for i := 0 to fOperations.Count - 1 do
2241 begin
2242 tmp := tmp + TRICOpBase(fOperations[i]).SaveAsDataArray(aLangName);
2243 if i < fOperations.Count - 1 then
2244 tmp := tmp + ', ';
2245 end;
2246 Result := 'dseg segment'#13#10 +
2247 ' ' + varname + ' byte[] ' + tmp + #13#10 +
2248 'dseg ends';
2249 end
2250 else
2251 Result := '// unable to import "' + ExtractFileName(CurrentFile) + '"';
2252 end;
2253
TRICComp.RICToDataArraynull2254 class function TRICComp.RICToDataArray(const aFilename, aVarName : string;
2255 const aLangName: TLangName): string;
2256 begin
2257 with TRICComp.Create do
2258 try
2259 LoadFromFile(aFilename);
2260 Result := SaveAsDataArray(aLangName, aVarName);
2261 finally
2262 Free;
2263 end;
2264 end;
2265
2266 procedure TRICComp.CheckFirmwareVersion(const MinVer : word; const msg : string);
2267 begin
2268 if FirmwareVersion < MinVer then
2269 AbortMsg(msg);
2270 end;
2271
2272 procedure TRICComp.DoFontOut;
2273 var
2274 op : TRICDescription;
2275 begin
2276 // add a description opcode
2277 op := TRICDescription.Create(RICOps);
2278 // parse and set its values
2279 // fontout(width, height);
2280 op.Options := $8001;
2281 Next;
2282 OpenParen;
2283 CheckNumeric;
2284 op.Width := ValueToWord;
2285 Next;
2286 MatchString(TOK_COMMA);
2287 CheckNumeric;
2288 op.Height := ValueToWord;
2289 Next;
2290 CloseParen;
2291 end;
2292
2293 { TRICDescription }
2294
2295 constructor TRICDescription.Create(aOwner : TRICOps);
2296 begin
2297 inherited Create(aOwner);
2298 fOpCode := IMG_DESCRIPTION_ID;
2299 fOpSize := SizeOf(IMG_OP_DESCRIPTION) - 2;
2300 end;
2301
2302 {
2303 procedure TRICDescription.Draw(aPoint: TImgPoint; Vars: TRICVariables;
2304 Options: Cardinal; aCanvas: TImgCanvas);
2305 begin
2306 // The description opcode is a NO-OP when it comes to drawing
2307 end;
2308 }
2309
2310 procedure TRICDescription.LoadFromStream(aStream: TStream);
2311 var
2312 w : word;
2313 begin
2314 inherited;
2315 w := 0;
2316 // read options, width, height from stream
2317 ReadWordFromStream(aStream, w); Options := w;
2318 ReadWordFromStream(aStream, w); Width := w;
2319 ReadWordFromStream(aStream, w); Height := w;
2320 end;
2321
TRICDescription.SaveAsDataArraynull2322 function TRICDescription.SaveAsDataArray(const aLangName: TLangName): string;
2323 begin
2324 if aLangName in [lnNBC, lnNXC] then
2325 begin
2326 Result := inherited SaveAsDataArray(aLangName);
2327 Result := Result + Format(', %s, %s, %s',
2328 [RICValueToStr(Options, aLangName),
2329 RICValueToStr(Width, aLangName),
2330 RICValueToStr(Height, aLangName)]);
2331 end
2332 else if aLangName = lnNXCHeader then
2333 Result := Format('RICOpDescription(%d, %d, %d)', [Options, Width, Height])
2334 else
2335 Result := '';
2336 end;
2337
2338 procedure TRICDescription.SaveToStream(aStream: TStream);
2339 begin
2340 inherited;
2341 // write options, width, height to stream
2342 WriteWordToStream(aStream, Options);
2343 WriteWordToStream(aStream, Width);
2344 WriteWordToStream(aStream, Height);
2345 end;
2346
2347 { TRICSprite }
2348
2349 procedure TRICSprite.Add(aValue: Byte);
2350 var
2351 O : TByteObject;
2352 begin
2353 O := TByteObject.Create;
2354 fBytes.Add(O);
2355 O.Value := aValue;
2356 inc(fOpSize, 1);
2357 end;
2358
Pownull2359 function Pow(k: Integer): Integer;
2360 var
2361 j, Count: Integer;
2362 begin
2363 if k > 0 then j := 2
2364 else j := 1;
2365 for Count := 1 to k - 1 do
2366 j := j * 2;
2367 Result := j;
2368 end;
2369
BinToDecnull2370 function BinToDec(Str: string): Integer;
2371 var
2372 Len, Res, i: Integer;
2373 begin
2374 Len:=Length(Str);
2375 Res:=0;
2376 for i:=1 to Len do
2377 if (Str[i]='0')or(Str[i]='1') then
2378 Res:=Res+Pow(Len-i)*StrToInt(Str[i])
2379 else
2380 raise Exception.CreateFmt(sStringNotBinary, [Str]);
2381 Result := Res;
2382 end;
2383
IsHexStringnull2384 function IsHexString(const val : string) : boolean;
2385 begin
2386 Result := Pos('0x', val) = 1;
2387 end;
2388
2389 procedure TRICSprite.AddBytes(val: string);
2390 var
2391 bHex : boolean;
2392 b : Byte;
2393 tmp : string;
2394 begin
2395 // parse string and add bytes as needed to sprite
2396 // each row must be either a hex string with an even number of hex digits
2397 // or a string containing only 1s and 0s where each character is a bit
2398 bHex := IsHexString(val);
2399 if bHex then
2400 System.Delete(val, 1, 2);
2401 if bHex and ((Length(val) mod 2) <> 0) then
2402 raise Exception.CreateFmt(sInvalidHexLength, [Length(val)]);
2403 while Length(val) > 0 do
2404 begin
2405 if bHex then
2406 begin
2407 tmp := Copy(val, 1, 2);
2408 System.Delete(val, 1, 2);
2409 b := Byte(StrToInt('$'+tmp));
2410 end
2411 else
2412 begin
2413 tmp := Copy(val, 1, 8);
2414 System.Delete(val, 1, 8);
2415 if Length(tmp) < 8 then
2416 tmp := tmp + StringOfChar('0', 8-Length(tmp));
2417 b := Byte(BinToDec(tmp));
2418 end;
2419 Add(b);
2420 end;
2421 end;
2422
BytesToWritenull2423 function TRICSprite.BytesToWrite: Integer;
2424 begin
2425 Result := Rows*RowBytes;
2426 if (Result mod 2) = 1 then
2427 Inc(Result);
2428 end;
2429
TRICSprite.CountBytesnull2430 class function TRICSprite.CountBytes(val: string): Word;
2431 var
2432 bHex : boolean;
2433 len : Word;
2434 begin
2435 // we count bytes based on the length of the string and
2436 // whether it is hex or not.
2437 bHex := IsHexString(val);
2438 if bHex then
2439 System.Delete(val, 1, 2);
2440 len := Word(Length(val));
2441 if bHex then
2442 Result := Word(len div 2)
2443 else
2444 begin
2445 Result := Word(len div 8);
2446 if (len mod 8) <> 0 then
2447 inc(Result);
2448 end;
2449 end;
2450
2451 constructor TRICSprite.Create(aOwner : TRICOps);
2452 begin
2453 inherited Create(aOwner);
2454 fBytes := TObjectList.Create;
2455 fOpCode := IMG_SPRITE_ID;
2456 fOpSize := SizeOf(IMG_OP_SPRITE) - 4; // remove sizeof(fOpCode) + 2 bytes
2457 end;
2458
2459 destructor TRICSprite.Destroy;
2460 begin
2461 FreeAndNil(fBytes);
2462 inherited;
2463 end;
2464
2465 {
2466 procedure TRICSprite.Draw(aPoint: TImgPoint; Vars: TRICVariables;
2467 Options: Cardinal; aCanvas: TImgCanvas);
2468 begin
2469 // drawing a sprite just copies the sprite into a data address
2470 // so that a future CopyBits opcode can access it.
2471 end;
2472 }
2473
GetBytenull2474 function TRICSprite.GetByte(Index: Integer): Byte;
2475 begin
2476 Result := TByteObject(fBytes[Index]).Value;
2477 end;
2478
TRICSprite.GetByteCountnull2479 function TRICSprite.GetByteCount: Integer;
2480 begin
2481 Result := fBytes.Count;
2482 end;
2483
TRICSprite.GetByteValuenull2484 function TRICSprite.GetByteValue(const idx: integer): Byte;
2485 begin
2486 if idx < ByteCount then
2487 Result := Bytes[idx]
2488 else
2489 Result := 0;
2490 end;
2491
TRICSprite.GetOpSizenull2492 function TRICSprite.GetOpSize: Word;
2493 begin
2494 Result := fOpSize;
2495 if (Result mod 2) = 1 then
2496 Inc(Result);
2497 end;
2498
2499 procedure TRICSprite.LoadFromStream(aStream: TStream);
2500 var
2501 da, r, rb : Word;
2502 B : Byte;
2503 BytesToRead, i : integer;
2504 begin
2505 inherited;
2506 da := 0;
2507 r := 0;
2508 rb := 0;
2509 B := 0;
2510 ReadWordFromStream(aStream, da);
2511 ReadWordFromStream(aStream, r);
2512 ReadWordFromStream(aStream, rb);
2513 DataAddr := da;
2514 Rows := r;
2515 RowBytes := rb;
2516 // read bytes from stream
2517 BytesToRead := Rows*RowBytes;
2518 if (BytesToRead mod 2) = 1 then
2519 Inc(BytesToRead);
2520 for i := 0 to BytesToRead - 1 do
2521 begin
2522 aStream.Read(B, 1);
2523 Add(B);
2524 end;
2525 end;
2526
TRICSprite.SaveAsDataArraynull2527 function TRICSprite.SaveAsDataArray(const aLangName: TLangName): string;
2528
OutputBytesnull2529 function OutputBytes(bIsNXCHeader : boolean) : string;
2530 var
2531 i, cnt : integer;
2532 B : Byte;
2533 begin
2534 if bIsNXCHeader then
2535 Result := 'RICSpriteData('
2536 else
2537 Result := '';
2538 cnt := BytesToWrite - 1;
2539 for i := 0 to cnt do
2540 begin
2541 B := GetByteValue(i);
2542 Result := Result + Format('0x%2.2x', [B]);
2543 if i < cnt then
2544 begin
2545 Result := Result + ', ';
2546 if bIsNXCHeader and ((i mod 8) = 0) and (i > 0) then
2547 Result := Result + #13#10' ';
2548 end;
2549 end;
2550 if bIsNXCHeader then
2551 Result := Result + ')';
2552 end;
2553 begin
2554 if aLangName in [lnNBC, lnNXC] then
2555 begin
2556 Result := inherited SaveAsDataArray(aLangName);
2557 Result := Result + Format(', %s, %s, %s, %s',
2558 [RICValueToStr(DataAddr, aLangName),
2559 RICValueToStr(Rows, aLangName),
2560 RICValueToStr(RowBytes, aLangName),
2561 OutputBytes(false)]);
2562 end
2563 else if aLangName = lnNXCHeader then
2564 begin
2565 Result := Format('RICOpSprite(%d, %d, %d,'#13#10' %s)',
2566 [DataAddr, Rows, RowBytes, OutputBytes(true)]);
2567 end
2568 else
2569 Result := '';
2570 end;
2571
2572 procedure TRICSprite.SaveToStream(aStream: TStream);
2573 var
2574 B : Byte;
2575 i : integer;
2576 begin
2577 inherited;
2578 WriteWordToStream(aStream, DataAddr);
2579 WriteWordToStream(aStream, Rows);
2580 WriteWordToStream(aStream, RowBytes);
2581 // now write out all the bytes in the Bytes array
2582 for i := 0 to BytesToWrite - 1 do
2583 begin
2584 B := GetByteValue(i);
2585 aStream.Write(B, 1);
2586 end;
2587 end;
2588
2589 procedure TRICSprite.SetByte(Index: Integer; const Value: Byte);
2590 begin
2591 TByteObject(fBytes[Index]).Value := Value;
2592 end;
2593
2594 { TRICOpBase }
2595
2596 constructor TRICOpBase.Create(aOwner : TRICOps);
2597 begin
2598 inherited Create;
2599 fOwner := aOwner;
2600 fOwner.Add(Self);
2601 fOpCode := 0;
2602 fOpSize := 0;
2603 end;
2604
2605 destructor TRICOpBase.Destroy;
2606 begin
2607 inherited;
2608 end;
2609
TRICOpBase.GetOpSizenull2610 function TRICOpBase.GetOpSize: Word;
2611 begin
2612 Result := fOpSize;
2613 end;
2614
2615 procedure TRICOpBase.LoadFromStream(aStream: TStream);
2616 var
2617 w : word;
2618 begin
2619 // read size and opcode from stream
2620 w := 0;
2621 ReadWordFromStream(aStream, w); OpSize := w;
2622 ReadWordFromStream(aStream, w); OpCode := w;
2623 end;
2624
TRICOpBase.SaveAsDataArraynull2625 function TRICOpBase.SaveAsDataArray(const aLangName: TLangName): string;
2626 begin
2627 if aLangName in [lnNBC, lnNXC] then
2628 Result := Format('%s, %s',
2629 [RICValueToStr(OpSize, aLangName), RICValueToStr(OpCode, aLangName)])
2630 else
2631 Result := '';
2632 end;
2633
2634 procedure TRICOpBase.SaveToStream(aStream: TStream);
2635 begin
2636 // write size and opcode to stream
2637 WriteWordToStream(aStream, OpSize);
2638 WriteWordToStream(aStream, OpCode);
2639 end;
2640
2641 { TRICVarMap }
2642
Addnull2643 function TRICVarMap.Add: TMapElement;
2644 begin
2645 Result := TMapElement.Create;
2646 fMapElements.Add(Result);
2647 inc(fOpSize, 4);
2648 end;
2649
2650 procedure TRICVarMap.AddMap(aMapElement: PIOV_MAPELT);
2651 var
2652 ME : TMapElement;
2653 begin
2654 ME := TMapElement.Create;
2655 fMapElements.Add(ME);
2656 ME.Domain := aMapElement^.Domain;
2657 ME.Range := aMapElement^.Range;
2658 inc(fOpSize, 4);
2659 end;
2660
2661 constructor TRICVarMap.Create(aOwner : TRICOps);
2662 begin
2663 inherited Create(aOwner);
2664 fMapElements := TObjectList.Create;
2665 fOpCode := IMG_VARMAP_ID;
2666 fOpSize := SizeOf(IMG_OP_VARMAP) - 10;
2667 end;
2668
2669 destructor TRICVarMap.Destroy;
2670 begin
2671 FreeAndNil(fMapElements);
2672 inherited;
2673 end;
2674
2675 {
2676 procedure TRICVarMap.Draw(aPoint: TImgPoint; Vars: TRICVariables;
2677 Options: Cardinal; aCanvas: TImgCanvas);
2678 begin
2679 // copy varmap to specified address
2680 end;
2681 }
2682
TRICVarMap.GetMapCountnull2683 function TRICVarMap.GetMapCount: Word;
2684 begin
2685 Result := Word(fMapElements.Count);
2686 end;
2687
GetMapElementnull2688 function TRICVarMap.GetMapElement(Index: Integer): TMapElement;
2689 begin
2690 Result := TMapElement(fMapElements[Index]);
2691 end;
2692
2693 procedure TRICVarMap.LoadFromStream(aStream: TStream);
2694 var
2695 da, mc, d, r : word;
2696 i : integer;
2697 ME : TMapElement;
2698 begin
2699 inherited;
2700 da := 0;
2701 mc := 0;
2702 d := 0;
2703 r := 0;
2704 ReadWordFromStream(aStream, da);
2705 ReadWordFromStream(aStream, mc);
2706 DataAddr := da;
2707 for i := 0 to mc - 1 do
2708 begin
2709 // read map elements from stream
2710 ReadWordFromStream(aStream, d);
2711 ReadWordFromStream(aStream, r);
2712 ME := Add;
2713 ME.Domain := d;
2714 ME.Range := r;
2715 end;
2716 end;
2717
TRICVarMap.SaveAsDataArraynull2718 function TRICVarMap.SaveAsDataArray(const aLangName: TLangName): string;
OutputBytesnull2719 function OutputBytes(bIsNXCHeader : boolean) : string;
2720 var
2721 i, cnt : integer;
2722 ME : TMapElement;
2723 begin
2724 if bIsNXCHeader then
2725 Result := 'RICMapFunction('
2726 else
2727 Result := '';
2728 cnt := MapCount - 1;
2729 for i := 0 to cnt do
2730 begin
2731 ME := Self.MapElements[i];
2732 if bIsNXCHeader then
2733 Result := Result + Format('RICMapElement(%d, %d)', [ME.Domain, ME.Range])
2734 else
2735 Result := Result + Format('%s, %s', [RICValueToStr(ME.Domain, lnNBC), RICValueToStr(ME.Range, lnNBC)]);
2736 if i < cnt then
2737 begin
2738 Result := Result + ', ';
2739 if bIsNXCHeader {and ((i mod 4) = 0) and (i > 0)} then
2740 Result := Result + #13#10' ';
2741 end;
2742 end;
2743 if bIsNXCHeader then
2744 Result := Result + ')';
2745 end;
2746 begin
2747 if aLangName in [lnNBC, lnNXC] then
2748 begin
2749 Result := inherited SaveAsDataArray(aLangName);
2750 Result := Result + Format(', %s, %s, %s',
2751 [RICValueToStr(DataAddr, aLangName),
2752 RICValueToStr(MapCount, aLangName),
2753 OutputBytes(false)]);
2754 end
2755 else if aLangName = lnNXCHeader then
2756 Result := Format('RICOpVarMap(%d, %d,'#13#10' %s)',
2757 [DataAddr,
2758 MapCount,
2759 OutputBytes(true)])
2760 else
2761 Result := '';
2762 end;
2763
2764 procedure TRICVarMap.SaveToStream(aStream: TStream);
2765 var
2766 i : integer;
2767 ME : TMapElement;
2768 begin
2769 inherited;
2770 WriteWordToStream(aStream, DataAddr);
2771 WriteWordToStream(aStream, MapCount);
2772 // now write out all the elements in the MapElement array
2773 for i := 0 to MapCount - 1 do
2774 begin
2775 ME := Self.MapElements[i];
2776 WriteWordToStream(aStream, ME.Domain);
2777 WriteWordToStream(aStream, ME.Range);
2778 end;
2779 end;
2780
2781 procedure TRICVarMap.SetMapElement(Index: Integer;
2782 const Value: TMapElement);
2783 begin
2784 TMapElement(fMapElements[Index]).Domain := Value.Domain;
2785 TMapElement(fMapElements[Index]).Range := Value.Range;
2786 end;
2787
2788 { TRICCopyBits }
2789
2790 constructor TRICCopyBits.Create(aOwner : TRICOps);
2791 begin
2792 inherited Create(aOwner);
2793 fOpCode := IMG_COPYBITS_ID;
2794 fOpSize := SizeOf(IMG_OP_COPYBITS) - 2;
2795 end;
2796
2797 {
2798 procedure TRICCopyBits.Draw(aPoint: TImgPoint; Vars: TRICVariables;
2799 Options: Cardinal; aCanvas: TImgCanvas);
2800 begin
2801 // draw bits from specified image
2802 end;
2803 }
2804
2805 procedure TRICCopyBits.LoadFromStream(aStream: TStream);
2806 var
2807 co, da : Word;
2808 r : TImgRect;
2809 p : TImgPoint;
2810 begin
2811 inherited;
2812 // read CopyOptions, DataAddr, SrcRect, DestPoint from stream
2813 co := 0;
2814 da := 0;
2815 r.Pt.X := 0;
2816 r.Pt.Y := 0;
2817 r.Width := 0;
2818 r.Height := 0;
2819 p.X := 0;
2820 p.Y := 0;
2821 ReadWordFromStream(aStream, co);
2822 ReadWordFromStream(aStream, da);
2823 ReadImgRectFromStream(aStream, r);
2824 ReadImgPointFromStream(aStream, p);
2825 CopyOptions := co;
2826 DataAddr := da;
2827 SrcRect := r;
2828 DestPoint := p;
2829 end;
2830
TRICCopyBits.SaveAsDataArraynull2831 function TRICCopyBits.SaveAsDataArray(const aLangName: TLangName): string;
2832 begin
2833 if aLangName in [lnNBC, lnNXC] then
2834 begin
2835 Result := inherited SaveAsDataArray(aLangName);
2836 Result := Result + Format(', %s, %s, %s, %s',
2837 [RICValueToStr(CopyOptions, aLangName),
2838 RICValueToStr(DataAddr, aLangName),
2839 RICRectToStr(SrcRect, aLangName),
2840 RICPointToStr(DestPoint, aLangName)]);
2841 end
2842 else if aLangName = lnNXCHeader then
2843 Result := Format('RICOpCopyBits(%s, %s, %s, %s)',
2844 [RICValueToStr(CopyOptions, aLangName),
2845 RICValueToStr(DataAddr, aLangName),
2846 RICRectToStr(SrcRect, aLangName),
2847 RICPointToStr(DestPoint, aLangName)])
2848 else
2849 Result := '';
2850 end;
2851
2852 procedure TRICCopyBits.SaveToStream(aStream: TStream);
2853 begin
2854 inherited;
2855 // write CopyOptions, DataAddr, SrcRect, DestPoint to stream
2856 WriteWordToStream(aStream, CopyOptions);
2857 WriteWordToStream(aStream, DataAddr);
2858 WriteImgRectToStream(aStream, SrcRect);
2859 WriteImgPointToStream(aStream, DestPoint);
2860 end;
2861
2862 { TRICPixel }
2863
2864 constructor TRICPixel.Create(aOwner : TRICOps);
2865 begin
2866 inherited Create(aOwner);
2867 fOpCode := IMG_PIXEL_ID;
2868 fOpSize := SizeOf(IMG_OP_PIXEL) - 2;
2869 // the standard NXT firmware has a bug in it which needs to be
2870 // worked around
2871 end;
2872
2873 {
2874 procedure TRICPixel.Draw(aPoint: TImgPoint; Vars: TRICVariables;
2875 Options: Cardinal; aCanvas: TImgCanvas);
2876 begin
2877 // draw this pixel to the specified canvas
2878 // resolve all the values as required
2879 end;
2880 }
2881
2882 procedure TRICPixel.LoadFromStream(aStream: TStream);
2883 var
2884 p : TImgPoint;
2885 co, v : Word;
2886 begin
2887 inherited;
2888 // read point from stream
2889 co := 0;
2890 v := 0;
2891 p.X := 0;
2892 p.Y := 0;
2893 ReadWordFromStream(aStream, co);
2894 ReadImgPointFromStream(aStream, p);
2895 ReadWordFromStream(aStream, v);
2896 CopyOptions := co;
2897 Point := p;
2898 Value := v;
2899 end;
2900
SaveAsDataArraynull2901 function TRICPixel.SaveAsDataArray(const aLangName: TLangName): string;
2902 begin
2903 if aLangName in [lnNBC, lnNXC] then
2904 begin
2905 Result := inherited SaveAsDataArray(aLangName);
2906 Result := Result + Format(', %s, %s, %s',
2907 [RICValueToStr(CopyOptions, aLangName),
2908 RICPointToStr(Point, aLangName),
2909 RICValueToStr(Value, aLangName)]);
2910 end
2911 else if aLangName = lnNXCHeader then
2912 Result := Format('RICOpPixel(%s, %s, %s)',
2913 [RICValueToStr(CopyOptions, aLangName),
2914 RICPointToStr(Point, aLangName),
2915 RICValueToStr(Value, aLangName)])
2916 else
2917 Result := '';
2918 end;
2919
2920 procedure TRICPixel.SaveToStream(aStream: TStream);
2921 begin
2922 inherited;
2923 WriteWordToStream(aStream, CopyOptions);
2924 WriteImgPointToStream(aStream, Point);
2925 WriteWordToStream(aStream, Value);
2926 end;
2927
2928 { TRICLine }
2929
2930 constructor TRICLine.Create(aOwner : TRICOps);
2931 begin
2932 inherited Create(aOwner);
2933 fOpCode := IMG_LINE_ID;
2934 fOpSize := SizeOf(IMG_OP_LINE) - 2;
2935 end;
2936
2937 {
2938 procedure TRICLine.Draw(aPoint: TImgPoint; Vars: TRICVariables;
2939 Options: Cardinal; aCanvas: TImgCanvas);
2940 begin
2941 // draw line as specified
2942 end;
2943 }
2944
2945 procedure TRICLine.LoadFromStream(aStream: TStream);
2946 var
2947 p1, p2 : TImgPoint;
2948 co : Word;
2949 begin
2950 inherited;
2951 co := 0;
2952 p1.X := 0;
2953 p1.Y := 0;
2954 p2.X := 0;
2955 p2.Y := 0;
2956 ReadWordFromStream(aStream, co);
2957 ReadImgPointFromStream(aStream, p1);
2958 ReadImgPointFromStream(aStream, p2);
2959 CopyOptions := co;
2960 Point1 := p1;
2961 Point2 := p2;
2962 end;
2963
SaveAsDataArraynull2964 function TRICLine.SaveAsDataArray(const aLangName: TLangName): string;
2965 begin
2966 if aLangName in [lnNBC, lnNXC] then
2967 begin
2968 Result := inherited SaveAsDataArray(aLangName);
2969 Result := Result + Format(', %s, %s, %s',
2970 [RICValueToStr(CopyOptions, aLangName),
2971 RICPointToStr(Point1, aLangName),
2972 RICPointToStr(Point2, aLangName)]);
2973 end
2974 else if aLangName = lnNXCHeader then
2975 Result := Format('RICOpLine(%s, %s, %s)',
2976 [RICValueToStr(CopyOptions, aLangName),
2977 RICPointToStr(Point1, aLangName),
2978 RICPointToStr(Point2, aLangName)])
2979 else
2980 Result := '';
2981 end;
2982
2983 procedure TRICLine.SaveToStream(aStream: TStream);
2984 begin
2985 inherited;
2986 WriteWordToStream(aStream, CopyOptions);
2987 WriteImgPointToStream(aStream, Point1);
2988 WriteImgPointToStream(aStream, Point2);
2989 end;
2990
2991 { TRICRect }
2992
2993 constructor TRICRect.Create(aOwner : TRICOps);
2994 begin
2995 inherited Create(aOwner);
2996 fOpCode := IMG_RECTANGLE_ID;
2997 fOpSize := SizeOf(IMG_OP_RECT) - 2;
2998 end;
2999
3000 {
3001 procedure TRICRect.Draw(aPoint: TImgPoint; Vars: TRICVariables;
3002 Options: Cardinal; aCanvas: TImgCanvas);
3003 begin
3004 // draw rectangle as specified
3005 end;
3006 }
3007
3008 procedure TRICRect.LoadFromStream(aStream: TStream);
3009 var
3010 p : TImgPoint;
3011 w, h : SmallInt;
3012 co : Word;
3013 begin
3014 inherited;
3015 co := 0;
3016 w := 0;
3017 h := 0;
3018 p.X := 0;
3019 p.Y := 0;
3020 ReadWordFromStream(aStream, co);
3021 ReadImgPointFromStream(aStream, p);
3022 ReadSmallIntFromStream(aStream, w);
3023 ReadSmallIntFromStream(aStream, h);
3024 CopyOptions := co;
3025 Point := p;
3026 Width := w;
3027 Height := h;
3028 end;
3029
SaveAsDataArraynull3030 function TRICRect.SaveAsDataArray(const aLangName: TLangName): string;
3031 begin
3032 if aLangName in [lnNBC, lnNXC] then
3033 begin
3034 Result := inherited SaveAsDataArray(aLangName);
3035 Result := Result + Format(', %s, %s, %s, %s',
3036 [RICValueToStr(CopyOptions, aLangName),
3037 RICPointToStr(Point, aLangName),
3038 RICValueToStr(Width, aLangName),
3039 RICValueToStr(Height, aLangName)]);
3040 end
3041 else if aLangName = lnNXCHeader then
3042 Result := Format('RICOpRect(%s, %s, %s, %s)',
3043 [RICValueToStr(CopyOptions, aLangName),
3044 RICPointToStr(Point, aLangName),
3045 RICValueToStr(Width, aLangName),
3046 RICValueToStr(Height, aLangName)])
3047 else
3048 Result := '';
3049 end;
3050
3051 procedure TRICRect.SaveToStream(aStream: TStream);
3052 begin
3053 inherited;
3054 WriteWordToStream(aStream, CopyOptions);
3055 WriteImgPointToStream(aStream, Point);
3056 WriteSmallIntToStream(aStream, Width);
3057 WriteSmallIntToStream(aStream, Height);
3058 end;
3059
3060 { TRICCircle }
3061
3062 constructor TRICCircle.Create(aOwner : TRICOps);
3063 begin
3064 inherited Create(aOwner);
3065 fOpCode := IMG_CIRCLE_ID;
3066 fOpSize := SizeOf(IMG_OP_CIRCLE) - 2;
3067 end;
3068
3069 {
3070 procedure TRICCircle.Draw(aPoint: TImgPoint; Vars: TRICVariables;
3071 Options: Cardinal; aCanvas: TImgCanvas);
3072 begin
3073 // draw circle as specified
3074 end;
3075 }
3076
3077 procedure TRICCircle.LoadFromStream(aStream: TStream);
3078 var
3079 p : TImgPoint;
3080 r, co : Word;
3081 begin
3082 inherited;
3083 co := 0;
3084 r := 0;
3085 p.X := 0;
3086 p.Y := 0;
3087 ReadWordFromStream(aStream, co);
3088 ReadImgPointFromStream(aStream, p);
3089 ReadWordFromStream(aStream, r);
3090 CopyOptions := co;
3091 Point := p;
3092 Radius := r;
3093 end;
3094
SaveAsDataArraynull3095 function TRICCircle.SaveAsDataArray(const aLangName: TLangName): string;
3096 begin
3097 if aLangName in [lnNBC, lnNXC] then
3098 begin
3099 Result := inherited SaveAsDataArray(aLangName);
3100 Result := Result + Format(', %s, %s, %s',
3101 [RICValueToStr(CopyOptions, aLangName),
3102 RICPointToStr(Point, aLangName),
3103 RICValueToStr(Radius, aLangName)]);
3104 end
3105 else if aLangName = lnNXCHeader then
3106 Result := Format('RICOpCircle(%s, %s, %s)',
3107 [RICValueToStr(CopyOptions, aLangName),
3108 RICPointToStr(Point, aLangName),
3109 RICValueToStr(Radius, aLangName)])
3110 else
3111 Result := '';
3112 end;
3113
3114 procedure TRICCircle.SaveToStream(aStream: TStream);
3115 begin
3116 inherited;
3117 WriteWordToStream(aStream, CopyOptions);
3118 WriteImgPointToStream(aStream, Point);
3119 WriteWordToStream(aStream, Radius);
3120 end;
3121
3122 { TRICNumBox }
3123
3124 constructor TRICNumBox.Create(aOwner : TRICOps);
3125 begin
3126 inherited Create(aOwner);
3127 fOpCode := IMG_NUMBOX_ID;
3128 fOpSize := SizeOf(IMG_OP_NUMBOX) - 2;
3129 end;
3130
3131 {
3132 procedure TRICNumBox.Draw(aPoint: TImgPoint; Vars: TRICVariables;
3133 Options: Cardinal; aCanvas: TImgCanvas);
3134 begin
3135 // draw numbox as specified
3136 end;
3137 }
3138
3139 procedure TRICNumBox.LoadFromStream(aStream: TStream);
3140 var
3141 p : TImgPoint;
3142 v, co : Word;
3143 begin
3144 inherited;
3145 co := 0;
3146 v := 0;
3147 p.X := 0;
3148 p.Y := 0;
3149 ReadWordFromStream(aStream, co);
3150 ReadImgPointFromStream(aStream, p);
3151 ReadWordFromStream(aStream, v);
3152 CopyOptions := co;
3153 Point := p;
3154 Value := v;
3155 end;
3156
SaveAsDataArraynull3157 function TRICNumBox.SaveAsDataArray(const aLangName: TLangName): string;
3158 begin
3159 if aLangName in [lnNBC, lnNXC] then
3160 begin
3161 Result := inherited SaveAsDataArray(aLangName);
3162 Result := Result + Format(', %s, %s, %s',
3163 [RICValueToStr(CopyOptions, aLangName),
3164 RICPointToStr(Point, aLangName),
3165 RICValueToStr(Value, aLangName)]);
3166 end
3167 else if aLangName = lnNXCHeader then
3168 Result := Format('RICOpNumBox(%s, %s, %s)',
3169 [RICValueToStr(CopyOptions, aLangName),
3170 RICPointToStr(Point, aLangName),
3171 RICValueToStr(Value, aLangName)])
3172 else
3173 Result := '';
3174 end;
3175
3176 procedure TRICNumBox.SaveToStream(aStream: TStream);
3177 begin
3178 inherited;
3179 WriteWordToStream(aStream, CopyOptions);
3180 WriteImgPointToStream(aStream, Point);
3181 WriteWordToStream(aStream, Value);
3182 end;
3183
3184 { TRICEllipse }
3185
3186 constructor TRICEllipse.Create(aOwner: TRICOps);
3187 begin
3188 inherited Create(aOwner);
3189 fOpCode := IMG_ELLIPSE_ID;
3190 fOpSize := SizeOf(IMG_OP_ELLIPSE) - 2;
3191 end;
3192
3193 {
3194 procedure TRICEllipse.Draw(aPoint: TImgPoint; Vars: TRICVariables;
3195 Options: Cardinal; aCanvas: TImgCanvas);
3196 begin
3197 // draw ellipse as specified
3198 end;
3199 }
3200
3201 procedure TRICEllipse.LoadFromStream(aStream: TStream);
3202 var
3203 p : TImgPoint;
3204 r1, r2, co : Word;
3205 begin
3206 inherited;
3207 co := 0;
3208 r1 := 0;
3209 r2 := 0;
3210 p.X := 0;
3211 p.Y := 0;
3212 ReadWordFromStream(aStream, co);
3213 ReadImgPointFromStream(aStream, p);
3214 ReadWordFromStream(aStream, r1);
3215 ReadWordFromStream(aStream, r2);
3216 CopyOptions := co;
3217 Point := p;
3218 Radius1 := r1;
3219 Radius2 := r2;
3220 end;
3221
TRICEllipse.SaveAsDataArraynull3222 function TRICEllipse.SaveAsDataArray(const aLangName: TLangName): string;
3223 begin
3224 if aLangName in [lnNBC, lnNXC] then
3225 begin
3226 Result := inherited SaveAsDataArray(aLangName);
3227 Result := Result + Format(', %s, %s, %s, %s',
3228 [RICValueToStr(CopyOptions, aLangName),
3229 RICPointToStr(Point, aLangName),
3230 RICValueToStr(Radius1, aLangName),
3231 RICValueToStr(Radius2, aLangName)]);
3232 end
3233 else if aLangName = lnNXCHeader then
3234 Result := Format('RICOpEllipse(%s, %s, %s, %s)',
3235 [RICValueToStr(CopyOptions, aLangName),
3236 RICPointToStr(Point, aLangName),
3237 RICValueToStr(Radius1, aLangName),
3238 RICValueToStr(Radius2, aLangName)])
3239 else
3240 Result := '';
3241 end;
3242
3243 procedure TRICEllipse.SaveToStream(aStream: TStream);
3244 begin
3245 inherited;
3246 WriteWordToStream(aStream, CopyOptions);
3247 WriteImgPointToStream(aStream, Point);
3248 WriteWordToStream(aStream, Radius1);
3249 WriteWordToStream(aStream, Radius2);
3250 end;
3251
3252 { TRICPolygon }
3253
Addnull3254 function TRICPolygon.Add: TPolyPoint;
3255 begin
3256 Result := TPolyPoint.Create;
3257 fPolyPoints.Add(Result);
3258 inc(fOpSize, 4);
3259 end;
3260
3261 procedure TRICPolygon.AddPoint(aPolyPoint: PIMG_PT);
3262 var
3263 PP : TPolyPoint;
3264 begin
3265 PP := TPolyPoint.Create;
3266 fPolyPoints.Add(PP);
3267 PP.X := aPolyPoint^.X;
3268 PP.Y := aPolyPoint^.Y;
3269 inc(fOpSize, 4);
3270 end;
3271
3272 constructor TRICPolygon.Create(aOwner: TRICOps);
3273 begin
3274 inherited Create(aOwner);
3275 fPolyPoints := TObjectList.Create;
3276 fOpCode := IMG_POLYGON_ID;
3277 fOpSize := SizeOf(IMG_OP_POLYGON) - 14; // remove 2 + 3*4
3278 end;
3279
3280 destructor TRICPolygon.Destroy;
3281 begin
3282 FreeAndNil(fPolyPoints);
3283 inherited;
3284 end;
3285
TRICPolygon.GetCountnull3286 function TRICPolygon.GetCount: Word;
3287 begin
3288 Result := Word(fPolyPoints.Count);
3289 end;
3290
GetPolyPointnull3291 function TRICPolygon.GetPolyPoint(Index: Integer): TPolyPoint;
3292 begin
3293 Result := TPolyPoint(fPolyPoints[Index]);
3294 end;
3295
3296 procedure TRICPolygon.LoadFromStream(aStream: TStream);
3297 var
3298 co, mc, x, y : word;
3299 i : integer;
3300 PP : TPolyPoint;
3301 begin
3302 inherited;
3303 co := 0;
3304 mc := 0;
3305 x := 0;
3306 y := 0;
3307 ReadWordFromStream(aStream, co);
3308 ReadWordFromStream(aStream, mc);
3309 CopyOptions := co;
3310 for i := 0 to mc - 1 do
3311 begin
3312 // read polygon points from stream
3313 ReadWordFromStream(aStream, x);
3314 ReadWordFromStream(aStream, y);
3315 PP := Add;
3316 PP.X := x;
3317 PP.Y := y;
3318 end;
3319 end;
3320
TRICPolygon.SaveAsDataArraynull3321 function TRICPolygon.SaveAsDataArray(const aLangName: TLangName): string;
OutputBytesnull3322 function OutputBytes(bIsNXCHeader : boolean) : string;
3323 var
3324 i, cnt : integer;
3325 PP : TPolyPoint;
3326 begin
3327 if bIsNXCHeader then
3328 Result := 'RICPolygonPoints('
3329 else
3330 Result := '';
3331 cnt := Count - 1;
3332 for i := 0 to cnt do
3333 begin
3334 PP := PolyPoints[i];
3335 if bIsNXCHeader then
3336 Result := Result + Format('RICImgPoint(%s, %s)',
3337 [RICValueToStr(PP.X, aLangName), RICValueToStr(PP.Y, aLangName)])
3338 else
3339 Result := Result + Format('%s, %s',
3340 [RICValueToStr(PP.X, lnNBC), RICValueToStr(PP.Y, lnNBC)]);
3341 if i < cnt then
3342 begin
3343 Result := Result + ', ';
3344 if bIsNXCHeader {and ((i mod 4) = 0) and (i > 0)} then
3345 Result := Result + #13#10' ';
3346 end;
3347 end;
3348 if bIsNXCHeader then
3349 Result := Result + ')';
3350 end;
3351 begin
3352 if aLangName in [lnNBC, lnNXC] then
3353 begin
3354 Result := inherited SaveAsDataArray(aLangName);
3355 Result := Result + Format(', %s, %s',
3356 [RICValueToStr(Count, aLangName),
3357 OutputBytes(false)]);
3358 end
3359 else if aLangName = lnNXCHeader then
3360 Result := Format('RICOpPolygon(%d,'#13#10' %s)',
3361 [Count,
3362 OutputBytes(true)])
3363 else
3364 Result := '';
3365 end;
3366
3367 procedure TRICPolygon.SaveToStream(aStream: TStream);
3368 var
3369 i : integer;
3370 PP : TPolyPoint;
3371 begin
3372 inherited;
3373 WriteWordToStream(aStream, CopyOptions);
3374 WriteWordToStream(aStream, Count);
3375 // now write out all the points in the PolyPoints array
3376 for i := 0 to Count - 1 do
3377 begin
3378 PP := PolyPoints[i];
3379 WriteWordToStream(aStream, PP.X);
3380 WriteWordToStream(aStream, PP.Y);
3381 end;
3382 end;
3383
3384 procedure TRICPolygon.SetPolyPoint(Index: Integer; const Value: TPolyPoint);
3385 begin
3386 TPolyPoint(fPolyPoints[Index]).X := Value.X;
3387 TPolyPoint(fPolyPoints[Index]).Y := Value.Y;
3388 end;
3389
3390 { TRICOps }
3391
3392 constructor TRICOps.Create;
3393 begin
3394 inherited Create;
3395 end;
3396
3397 destructor TRICOps.Destroy;
3398 begin
3399
3400 inherited;
3401 end;
3402
3403 {
3404 procedure TRICOps.Draw(aPoint: TImgPoint; Vars: TRICVariables;
3405 Options: Cardinal; aCanvas: TImgCanvas);
3406 var
3407 i : integer;
3408 begin
3409 for i := 0 to Count - 1 do
3410 TRICOpBase(Items[i]).Draw(aPoint, Vars, Options, aCanvas);
3411 end;
3412 }
3413
3414 (*
3415 {$IFNDEF FPC}
3416 initialization
3417 TPicture.RegisterFileFormat('BMP', 'Bitmap', TBitmap);
3418
3419 finalization
3420 TPicture.UnregisterGraphicClass(TBitmap);
3421 {$ENDIF}
3422 *)
3423
3424 end.
3425