← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to packages/base/graph/amiga/graph.pp

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
packages/base/graph/amiga/graph.pp
 
1
unit Graph;
 
2
 
 
3
{ *********************************************************************
 
4
 
 
5
  Info:
 
6
 
 
7
  This units mimics some parts of borland's graph unit for
 
8
  Amiga.
 
9
 
 
10
  You have to use crt for readln, readkey and stuff like
 
11
  that for your programs. When the show is over you should
 
12
  just press a key or hit return to close everything down.
 
13
 
 
14
  If that doesn't work just flip the screens with left-Amiga n
 
15
  and activate the shell you started from.
 
16
 
 
17
  I have compiled and run mandel.pp without any problems.
 
18
 
 
19
  This version requires Free Pascal 0.99.5c or higher.
 
20
 
 
21
  It will also use some amigaunits, when the unit gets
 
22
  better we can remove those units.
 
23
 
 
24
  Large parts have not yet been implemented or tested.
 
25
 
 
26
  nils.sjoholm@mailbox.swipnet.se  (Nils Sjoholm)
 
27
 
 
28
  History:
 
29
 
 
30
  Date       Version  Who      Comments
 
31
  ---------- -------- -------  -------------------------------------
 
32
  27-Nov-98  0.1      nsjoholm Initial version.
 
33
 
 
34
  License Conditions:
 
35
 
 
36
  This library is free software; you can redistribute it and/or
 
37
  modify it under the terms of the GNU Library General Public
 
38
  License as published by the Free Software Foundation; either
 
39
  version 2 of the License, or (at your option) any later version.
 
40
 
 
41
  This library is distributed in the hope that it will be useful,
 
42
  but WITHOUT ANY WARRANTY; without even the implied warranty of
 
43
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 
44
  Library General Public License for more details.
 
45
 
 
46
  You should have received a copy of the GNU Library General Public
 
47
  License along with this library; if not, write to the Free
 
48
  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
49
 
 
50
 
 
51
  *********************************************************************}
 
52
 
 
53
 
 
54
interface
 
55
 
 
56
uses Exec, Intuition, Graphics, Utility;
 
57
 
 
58
{ ---------------------------------------------------------------------
 
59
   Constants
 
60
 
 
61
  ---------------------------------------------------------------------}
 
62
 
 
63
const
 
64
  NormalPut       = 0;
 
65
  CopyPut         = 0;
 
66
  XORPut          = 1;
 
67
  ORPut           = 2;
 
68
  ANDPut          = 3;
 
69
  NotPut          = 4;
 
70
  BackPut         = 8;
 
71
 
 
72
  Black           =  0;
 
73
  Blue            =  1;
 
74
  Green           =  2;
 
75
  Cyan            =  3;
 
76
  Red             =  4;
 
77
  Magenta         =  5;
 
78
  Brown           =  6;
 
79
  LightGray       =  7;
 
80
  DarkGray        =  8;
 
81
  LightBlue       =  9;
 
82
  LightGreen      = 10;
 
83
  LightCyan       = 11;
 
84
  LightRed        = 12;
 
85
  LightMagenta    = 13;
 
86
  Yellow          = 14;
 
87
  White           = 15;
 
88
  Border          = 16;
 
89
 
 
90
  SolidLn         = 0;
 
91
  DottedLn        = 1;
 
92
  CenterLn        = 2;
 
93
  DashedLn        = 3;
 
94
  UserBitLn       = 4;
 
95
 
 
96
  EmptyFill       = 0;
 
97
  SolidFill       = 1;
 
98
  LineFill        = 2;
 
99
  LtSlashFill     = 3;
 
100
  SlashFill       = 4;
 
101
  BkSlashFill     = 5;
 
102
  LtBkSlashFill   = 6;
 
103
  HatchFill       = 7;
 
104
  XHatchFill      = 8;
 
105
  InterleaveFill  = 9;
 
106
  WideDotFill     = 10;
 
107
  CloseDotFill    = 11;
 
108
  UserFill        = 12;
 
109
 
 
110
  NormWidth       = 1;
 
111
  ThickWidth      = 3;
 
112
 
 
113
const
 
114
  LeftText      = 0;
 
115
  CenterText    = 1;
 
116
  RightText     = 2;
 
117
  BottomText    = 0;
 
118
  TopText       = 2;
 
119
  BaseLine      = 3;
 
120
  LeadLine      = 4;
 
121
 
 
122
const
 
123
  { Error codes }
 
124
  grOK             = 0;
 
125
  grNoInitGraph    = -1;
 
126
  grNotDetected    = -2;
 
127
  grFileNotFound   = -3;
 
128
  grInvalidDriver  = -4;
 
129
  grNoLOadMem      = -5;
 
130
  grNoScanMem      = -6;
 
131
  grNoFloodMem     = -7;
 
132
  grFontNotFound   = -8;
 
133
  grNoFontMem      = -9;
 
134
  grInvalidmode    = -10;
 
135
  grError          = -11;
 
136
  grIOerror        = -12;
 
137
  grInvalidFont    = -13;
 
138
  grInvalidFontNum = -14;
 
139
 
 
140
Type
 
141
  FillPatternType = array[1..8] of byte;
 
142
 
 
143
  ArcCoordsType = record
 
144
     x,y : integer;
 
145
     xstart,ystart : integer;
 
146
     xend,yend : integer;
 
147
  end;
 
148
 
 
149
  RGBColor = record
 
150
    r,g,b,i : byte;
 
151
  end;
 
152
 
 
153
 
 
154
  PaletteType = record
 
155
     Size   : integer;
 
156
     Colors : array[0..767]of Byte;
 
157
  end;
 
158
 
 
159
 
 
160
  LineSettingsType = record
 
161
     linestyle : word;
 
162
     pattern : word;
 
163
     thickness : word;
 
164
  end;
 
165
 
 
166
  TextSettingsType = record
 
167
     font : word;
 
168
     direction : word;
 
169
     charsize : word;
 
170
     horiz : word;
 
171
     vert : word;
 
172
  end;
 
173
 
 
174
  FillSettingsType = record
 
175
     pattern : word;
 
176
     color : longint;
 
177
  end;
 
178
 
 
179
  PointType = record
 
180
     x,y : integer;
 
181
  end;
 
182
 
 
183
  ViewPortType = record
 
184
     x1,y1,x2,y2 : integer;
 
185
     Clip : boolean;
 
186
  end;
 
187
 
 
188
 const
 
189
  fillpattern : array[0..12] of FillPatternType = (
 
190
      ($00,$00,$00,$00,$00,$00,$00,$00),     { Hintergrundfarbe }
 
191
      ($ff,$ff,$ff,$ff,$ff,$ff,$ff,$ff),     { Vordergrundfarbe }
 
192
      ($ff,$ff,$00,$00,$ff,$ff,$00,$00),     { === }
 
193
      ($01,$02,$04,$08,$10,$20,$40,$80),     { /// }
 
194
      ($07,$0e,$1c,$38,$70,$e0,$c1,$83),     { /// als dicke Linien }
 
195
      ($07,$83,$c1,$e0,$70,$38,$1c,$0e),     { \\\ als dicke Linien }
 
196
      ($5a,$2d,$96,$4b,$a5,$d2,$69,$b4),     { \ \\ \ }
 
197
      ($ff,$88,$88,$88,$ff,$88,$88,$88),     { K�stchen }
 
198
      ($18,$24,$42,$81,$81,$42,$24,$18),     { Rauten }
 
199
      ($cc,$33,$cc,$33,$cc,$33,$cc,$33),     { "Mauermuster" }
 
200
      ($80,$00,$08,$00,$80,$00,$08,$00),     { weit auseinanderliegende Punkte }
 
201
      ($88,$00,$22,$00,$88,$00,$22,$00),     { dichte Punkte}
 
202
      (0,0,0,0,0,0,0,0)                      { benutzerdefiniert }
 
203
     );
 
204
 
 
205
 
 
206
 
 
207
 
 
208
 
 
209
{ ---------------------------------------------------------------------
 
210
   Function Declarations
 
211
 
 
212
  ---------------------------------------------------------------------}
 
213
 
 
214
{ Retrieving coordinates }
 
215
function  GetX: Integer;
 
216
function  GetY: Integer;
 
217
 
 
218
{ Pixel-oriented routines }
 
219
procedure PutPixel(X, Y: Integer; Pixel: Word);
 
220
function  GetPixel(X, Y: Integer): Integer;
 
221
 
 
222
{ Line-oriented primitives }
 
223
procedure LineTo(X, Y: Integer);
 
224
procedure LineRel(Dx, Dy: Integer);
 
225
procedure MoveTo(X, Y: Integer);
 
226
procedure MoveRel(Dx, Dy: Integer);
 
227
procedure Line(x1, y1, x2, y2: Integer);
 
228
 
 
229
{ Linearly bounded primitives }
 
230
procedure Rectangle(x1, y1, x2, y2: Integer);
 
231
procedure Bar(x1, y1, x2, y2: Integer);
 
232
procedure Bar3D(x1, y1, x2, y2: Integer; Depth: Word; Top: Boolean);
 
233
procedure FloodFill(X, Y: Integer; Border: Word);
 
234
 
 
235
{ Nonlinearly bounded primitives }
 
236
 
 
237
procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word);
 
238
procedure GetArcCoords(var ArcCoords: ArcCoordsType);
 
239
procedure Circle(X, Y: Integer; Radius: Word);
 
240
procedure Ellipse(X, Y: Integer; StAngle, EndAngle: Word; XRadius, YRadius : Word);
 
241
procedure FillEllipse(X, Y: Integer; XRadius, YRadius : Word);
 
242
procedure SetAspectRatio(Xasp, Yasp: Word);
 
243
procedure PieSlice(X, Y: Integer; StAngle, EndAngle, Radius: Word);
 
244
procedure Sector(X, Y: Integer; StAngle, EndAngle, XRadius, YRadius: Word);
 
245
 
 
246
{ Color routines }
 
247
procedure SetBkColor(ColorNum: Word);
 
248
procedure SetColor(Color: Word);
 
249
Function  GetBkColor : Word;
 
250
Function  GetColor : Word;
 
251
function  GetMaxColor : Word;
 
252
 
 
253
function  GetMaxX : Integer;
 
254
function  GetMAxY : Integer;
 
255
function  GetAspect: Real;
 
256
procedure GetAspectRatio(var x,y : Word);
 
257
 
 
258
{ Graph clipping method }
 
259
Procedure ClearViewPort;
 
260
 
 
261
function GraphResult: Integer;
 
262
 
 
263
{ For compatibility }
 
264
Procedure InitGraph (Var Driver,Mode : Integer;DriverPath : String);
 
265
Procedure CloseGraph;
 
266
 
 
267
const
 
268
  NoGraphics: Boolean = false;
 
269
 
 
270
  { VGA modes }
 
271
  GTEXT             = 0;                { Compatible with VGAlib v1.2 }
 
272
  G320x200x16       = 1;
 
273
  G640x200x16       = 2;
 
274
  G640x350x16       = 3;
 
275
  G640x480x16       = 4;
 
276
  G320x200x256      = 5;
 
277
  G320x240x256      = 6;
 
278
  G320x400x256      = 7;
 
279
  G360x480x256      = 8;
 
280
  G640x480x2        = 9;
 
281
 
 
282
  G640x480x256      = 10;
 
283
  G800x600x256      = 11;
 
284
  G1024x768x256     = 12;
 
285
 
 
286
  G1280x1024x256    = 13;   { Additional modes. }
 
287
 
 
288
  G320x200x32K      = 14;
 
289
  G320x200x64K      = 15;
 
290
  G320x200x16M      = 16;
 
291
  G640x480x32K      = 17;
 
292
  G640x480x64K      = 18;
 
293
  G640x480x16M      = 19;
 
294
  G800x600x32K      = 20;
 
295
  G800x600x64K      = 21;
 
296
  G800x600x16M      = 22;
 
297
  G1024x768x32K     = 23;
 
298
  G1024x768x64K     = 24;
 
299
  G1024x768x16M     = 25;
 
300
  G1280x1024x32K    = 26;
 
301
  G1280x1024x64K    = 27;
 
302
  G1280x1024x16M    = 28;
 
303
 
 
304
  G800x600x16       = 29;
 
305
  G1024x768x16      = 30;
 
306
  G1280x1024x16     = 31;
 
307
 
 
308
  G720x348x2        = 32;               { Hercules emulation mode }
 
309
 
 
310
  G320x200x16M32    = 33;       { 32-bit per pixel modes. }
 
311
  G640x480x16M32    = 34;
 
312
  G800x600x16M32    = 35;
 
313
  G1024x768x16M32   = 36;
 
314
  G1280x1024x16M32  = 37;
 
315
 
 
316
  { additional resolutions }
 
317
  G1152x864x16      = 38;
 
318
  G1152x864x256     = 39;
 
319
  G1152x864x32K     = 40;
 
320
  G1152x864x64K     = 41;
 
321
  G1152x864x16M     = 42;
 
322
  G1152x864x16M32   = 43;
 
323
 
 
324
  G1600x1200x16     = 44;
 
325
  G1600x1200x256    = 45;
 
326
  G1600x1200x32K    = 46;
 
327
  G1600x1200x64K    = 47;
 
328
  G1600x1200x16M    = 48;
 
329
  G1600x1200x16M32  = 49;
 
330
 
 
331
  GLASTMODE         = 49;
 
332
 
 
333
 
 
334
implementation
 
335
 
 
336
{$I tagutils.inc}
 
337
 
 
338
{ ---------------------------------------------------------------------
 
339
   Types, constants and variables
 
340
 
 
341
  ---------------------------------------------------------------------}
 
342
VAR     GraphScr     :pScreen;
 
343
        GraphWin     :pWindow;
 
344
        CurrentRastPort : pRastPort;
 
345
        TheAspect   : Real;
 
346
        GraphResultCode : Integer;
 
347
 
 
348
        Msg     :pIntuiMessage;
 
349
        Ende    :Boolean;
 
350
 
 
351
var
 
352
  DrawDelta: TPoint;
 
353
  CurX, CurY: Integer;
 
354
  TheColor, TheFillColor: LongInt;
 
355
  IsVirtual: Boolean;
 
356
  ColorTable: array[0..15] of LongInt;
 
357
  TheFillPattern : FillPatternType;
 
358
  TheLineSettings : LineSettingsType;
 
359
  ThePalette : PaletteType;
 
360
  TheTextSettings : TextSettingsType;
 
361
  TheFillSettings : FillSettingsType;
 
362
 
 
363
const
 
364
  BgiColors: array[0..15] of LongInt
 
365
    = ($000000, $000080, $008000, $008080,
 
366
       $800000, $800080, $808000, $C0C0C0,
 
367
       $808080, $0000FF, $00FF00, $00FFFF,
 
368
       $FF0000, $FF00FF, $FFFF00, $FFFFFF);
 
369
 
 
370
const
 
371
  DoUseMarker: Boolean = true;
 
372
  TheMarker: Char      = '~';
 
373
  TextColor: LongInt   = 15;
 
374
  MarkColor: LongInt   = 15;
 
375
  BackColor: LongInt   = 0;
 
376
  FontWidth: Integer   = 8;
 
377
  FontHeight: Integer  = 8;
 
378
 
 
379
var
 
380
  sHoriz, sVert: Word;
 
381
 
 
382
{ initialisierte Variablen }
 
383
const
 
384
  SourcePage: Word = 0;
 
385
  DestPage: Word = 0;
 
386
 
 
387
{ Retrieves the capabilities for the current mode }
 
388
const
 
389
  vmcImage       = 1;
 
390
  vmcCopy        = 2;
 
391
  vmcSaveRestore = 4;
 
392
  vmcBuffer      = 8;
 
393
  vmcBackPut     = 16;
 
394
 
 
395
{ ---------------------------------------------------------------------
 
396
   Graphics Vision Layer
 
397
  ---------------------------------------------------------------------}
 
398
 
 
399
 
 
400
{ Types and constants }
 
401
var
 
402
  SizeX, SizeY: Word;
 
403
 
 
404
{ Font attributes }
 
405
const
 
406
  ftNormal          = 0;
 
407
  ftBold            = 1;
 
408
  ftThin            = 2;
 
409
  ftItalic          = 4;
 
410
 
 
411
var
 
412
  sFont, sColor:Word;
 
413
  sCharSpace: Integer;
 
414
{ Not used
 
415
  sMarker: Char;
 
416
  sAttr: Word; }
 
417
 
 
418
{ Bitmap utilities }
 
419
type
 
420
  PBitmap = ^TBitmap;
 
421
  TBitmap = record
 
422
              Width, Height: Integer;
 
423
              Data: record end;
 
424
            end;
 
425
 
 
426
 
 
427
const
 
428
  pbNone  = 0;
 
429
  pbCopy  = 1;
 
430
  pbClear = 2;
 
431
 
 
432
procedure SetColors;
 
433
begin
 
434
   SetRGB4(@GraphScr^.ViewPort, Black    , 0,0,0);
 
435
   SetRGB4(@GraphScr^.ViewPort, Blue     , 0,0,15);
 
436
   SetRGB4(@GraphScr^.ViewPort, Green    , 0,15,0);
 
437
   SetRGB4(@GraphScr^.ViewPort, Cyan     , 0,15,15);
 
438
   SetRGB4(@GraphScr^.ViewPort, Red      , 15,0,0);
 
439
   SetRGB4(@GraphScr^.ViewPort, Magenta  , 15,0,15);
 
440
   SetRGB4(@GraphScr^.ViewPort, Brown    , 6,2,0);
 
441
   SetRGB4(@GraphScr^.ViewPort, LightGray, 13,13,13);
 
442
   SetRGB4(@GraphScr^.ViewPort, DarkGray , 4,4,4);
 
443
   SetRGB4(@GraphScr^.ViewPort, LightBlue, 5,5,5);
 
444
   SetRGB4(@GraphScr^.ViewPort, LightGreen ,9,15,1);
 
445
   SetRGB4(@GraphScr^.ViewPort, LightRed   ,14,5,0);
 
446
   SetRGB4(@GraphScr^.ViewPort, LightMagenta ,0,15,8);
 
447
   SetRGB4(@GraphScr^.ViewPort, Yellow   ,15,15,0);
 
448
   SetRGB4(@GraphScr^.ViewPort, White    ,15,15,15);
 
449
end;
 
450
 
 
451
 
 
452
{ ---------------------------------------------------------------------
 
453
   Real graph implementation
 
454
  ---------------------------------------------------------------------}
 
455
 
 
456
function GraphResult: Integer;
 
457
begin
 
458
   GraphResult := GraphResultCode;
 
459
end;
 
460
 
 
461
Procedure ClearViewPort;
 
462
begin
 
463
   SetRast(CurrentRastPort,Black);
 
464
end;
 
465
 
 
466
function GetX: Integer;
 
467
begin
 
468
  GetX := CurX;
 
469
end;
 
470
 
 
471
function GetY: Integer;
 
472
begin
 
473
  GetY := CurY;
 
474
end;
 
475
 
 
476
function GetAspect: Real;
 
477
begin
 
478
   GetAspect := GetMaxY/GetMaxX;
 
479
end;
 
480
 
 
481
procedure GetAspectRatio(var x,y : Word);
 
482
begin
 
483
   x := GetMaxX;
 
484
   y := GetMaxY;
 
485
end;
 
486
 
 
487
{ Pixel-oriented routines }
 
488
procedure PutPixel(x,y : Integer; Pixel : Word);
 
489
begin
 
490
   SetAPen(CurrentRastPort,Pixel);
 
491
   WritePixel(CurrentRastPort,x,y);
 
492
   CurX := x;
 
493
   CurY := y;
 
494
end;
 
495
 
 
496
function GetPixel(X, Y: Integer): Integer;
 
497
begin
 
498
   GetPixel := ReadPixel(CurrentRastPort,X,Y);
 
499
end;
 
500
 
 
501
{ Line-oriented primitives }
 
502
 
 
503
procedure LineTo(X, Y: Integer);
 
504
begin
 
505
   Draw(CurrentRastPort,X,Y);
 
506
   CurX := X;
 
507
   CurY := Y;
 
508
end;
 
509
 
 
510
procedure LineRel(Dx, Dy: Integer);
 
511
begin
 
512
   CurX := CurX + Dx;
 
513
   CurY := CurY + Dy;
 
514
   Draw(CurrentRastPort, Curx, CurY);
 
515
end;
 
516
 
 
517
procedure MoveTo(X, Y: Integer);
 
518
begin
 
519
   Move(CurrentRastPort, X , Y);
 
520
   CurX := X;
 
521
   CurY := Y;
 
522
end;
 
523
 
 
524
procedure MoveRel(Dx, Dy: Integer);
 
525
begin
 
526
   CurX := CurX + Dx;
 
527
   CurY := CurY + Dy;
 
528
   Move(CurrentRastPort, Curx, CurY);
 
529
end;
 
530
 
 
531
procedure Line(x1,y1,x2,y2: Integer);
 
532
begin
 
533
   Move(CurrentRastPort,x1,y1);
 
534
   Draw(CurrentRastPort,x2,y2);
 
535
   Move(CurrentRastPort,CurX, CurY);
 
536
end;
 
537
 
 
538
procedure Rectangle(x1, y1, x2, y2: Integer);
 
539
begin
 
540
   Move(CurrentRastPort, x1, y1);
 
541
   Draw(CurrentRastPort, x2, y1);
 
542
   Draw(CurrentRastPort, x2, y2);
 
543
   Draw(CurrentRastPort, x1, y2);
 
544
   Draw(CurrentRastPort, x1, y1);
 
545
   CurX := x1;
 
546
   CurY := y1;
 
547
end;
 
548
 
 
549
procedure Bar(x1, y1, x2, y2: Integer);
 
550
begin
 
551
   RectFill(CurrentRastPort, x1, y1, x2, y2);
 
552
   CurX := x1;
 
553
   CurY := y1;
 
554
end;
 
555
 
 
556
procedure Bar3D(x1, y1, x2, y2: Integer; Depth: Word; Top: Boolean);
 
557
begin
 
558
  Bar(x1,y1,x2,y2);
 
559
  Rectangle(x1,y1,x2,y2);
 
560
  if top then begin
 
561
     Moveto(x1,y1);
 
562
     Lineto(x1+depth,y1-depth);
 
563
     Lineto(x2+depth,y1-depth);
 
564
     Lineto(x2,y1);
 
565
  end;
 
566
  Moveto(x2+depth,y1-depth);
 
567
  Lineto(x2+depth,y2-depth);
 
568
  Lineto(x2,y2);
 
569
 
 
570
end;
 
571
 
 
572
procedure FloodFill(X, Y: Integer; Border: Word);
 
573
begin
 
574
 
 
575
end;
 
576
 
 
577
Var LastArcCoords : ArcCoordsType;
 
578
 
 
579
 
 
580
procedure SetArcCoords (X,y,xradius,yradius,Stangle,endangle : integer);
 
581
 
 
582
begin
 
583
  LastArcCoords.X:=X;
 
584
  LastArccOords.y:=y;
 
585
  Lastarccoords.xstart:=x+round(xradius*cos(stangle*pi/180));
 
586
  Lastarccoords.ystart:=y-round(yradius*sin(stangle*pi/180));
 
587
  LastArccoords.xend:=x+round(xradius*cos(endangle*pi/180));
 
588
  LastArccoords.yend:=y-round(yradius*sin(endangle*pi/180));
 
589
end;
 
590
 
 
591
 
 
592
procedure GetArcCoords(var ArcCoords: ArcCoordsType);
 
593
 
 
594
begin
 
595
  ArcCoords:=LastArcCoords;
 
596
end;
 
597
 
 
598
procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word);
 
599
 
 
600
begin
 
601
 Ellipse (X,y,stangle,endangle,Radius,radius);
 
602
end;
 
603
 
 
604
procedure Circle(X, Y: Integer; Radius: Word);
 
605
begin
 
606
   DrawEllipse(CurrentRastPort, x, y, Round(Radius * TheAspect), Radius);
 
607
end;
 
608
 
 
609
procedure Ellipse(X, Y: Integer;
 
610
  StAngle, EndAngle: Word; XRadius, YRadius : Word);
 
611
 
 
612
Var I : longint;
 
613
    tmpang : real;
 
614
 
 
615
begin
 
616
 SetArcCoords (X,Y,xradius,yradius,Stangle,EndAngle);
 
617
 For i:= StAngle To EndAngle Do
 
618
  Begin
 
619
   tmpAng:= i*Pi/180;
 
620
   curX:= X + Round (xRadius*Cos (tmpAng));
 
621
   curY:= Y - Round (YRadius*Sin (tmpAng));
 
622
   PutPixel (curX, curY, TheColor);
 
623
  End;
 
624
end;
 
625
 
 
626
procedure FillEllipse(X, Y: Integer; XRadius, YRadius : Word);
 
627
 
 
628
Var I,tmpcolor : longint;
 
629
    tmpang : real;
 
630
    tmpx,tmpy : Integer;
 
631
 
 
632
begin
 
633
 tmpcolor:=Thecolor;
 
634
 SetColor(TheFillColor);
 
635
 For i:= 0 to 180 Do
 
636
  Begin
 
637
   tmpAng:= i*Pi/180;
 
638
   curX:= Round (xRadius*Cos (tmpAng));
 
639
   curY:= Round (YRadius*Sin (tmpAng));
 
640
   tmpX:= X - curx;
 
641
   tmpy:= Y + cury;
 
642
   curx:=x+curx;
 
643
   cury:=y-cury;
 
644
   Line (curX, curY,tmpx,tmpy);
 
645
   PutPixel (curx,cury,tmpcolor);
 
646
   PutPixel (tmpx,tmpy,tmpcolor);
 
647
  End;
 
648
  SetColor(tmpcolor);
 
649
end;
 
650
 
 
651
procedure SetAspectRatio(Xasp, Yasp: Word);
 
652
begin
 
653
  //!! Needs implementing.
 
654
end;
 
655
 
 
656
procedure PieSlice(X, Y: Integer; StAngle, EndAngle, Radius: Word);
 
657
 
 
658
Begin
 
659
 sector (x,y,stangle,endangle,radius,radius);
 
660
end;
 
661
 
 
662
procedure Sector(X, Y: Integer;
 
663
  StAngle, EndAngle, XRadius, YRadius: Word);
 
664
 
 
665
Var I,tmpcolor : longint;
 
666
    tmpang : real;
 
667
    ac : arccoordstype;
 
668
 
 
669
begin
 
670
 tmpcolor:=Thecolor;
 
671
 SetColor(TheFillColor);
 
672
 For i:= stangle to endangle Do
 
673
   Begin
 
674
   tmpAng:= i*Pi/180;
 
675
   curX:= x+Round (xRadius*Cos (tmpAng));
 
676
   curY:= y-Round (YRadius*Sin (tmpAng));
 
677
   Line (x,y,curX, curY);
 
678
   PutPixel (curx,cury,tmpcolor);
 
679
   End;
 
680
 SetColor(tmpcolor);
 
681
 getarccoords(ac);
 
682
 Line (x,y,ac.xstart,ac.ystart);
 
683
 Line (x,y,ac.xend,ac.yend);
 
684
end;
 
685
 
 
686
{ Color routines
 
687
}
 
688
 
 
689
procedure SetBkColor(ColorNum: Word);
 
690
begin
 
691
  SetBPen(CurrentRastPort, ColorNum);
 
692
  BackColor := ColorNum;
 
693
end;
 
694
 
 
695
Function GetBkColor : Word;
 
696
 
 
697
begin
 
698
  GetBkColor:=BackColor;
 
699
end;
 
700
 
 
701
Function GetColor : Word;
 
702
 
 
703
begin
 
704
  GetColor:=TheColor;
 
705
end;
 
706
 
 
707
procedure SetColor(color : Word);
 
708
begin
 
709
   SetAPen(CurrentRastPort,color);
 
710
   TheColor := color;
 
711
end;
 
712
 
 
713
function GetMaxColor: word;
 
714
begin
 
715
   GetMaxColor := 15;
 
716
end;
 
717
 
 
718
function GetMaxX: Integer;
 
719
begin
 
720
   GetMaxX := GraphWin^.Width;
 
721
end;
 
722
 
 
723
function GetMaxY: Integer;
 
724
begin
 
725
   GetMaxY := GraphWin^.Height;
 
726
end;
 
727
 
 
728
Procedure InitGraph (Var Driver,Mode : Integer;DriverPath : String);
 
729
var
 
730
  thetags : array[0..3] of tTagItem;
 
731
 
 
732
BEGIN
 
733
  GraphResultCode := grOK;
 
734
  GfxBase := OpenLibrary(GRAPHICSNAME,0);
 
735
  if GfxBase = nil then begin
 
736
      GraphResultCode := grNoInitGraph;
 
737
      Exit;
 
738
  end;
 
739
 
 
740
  GraphScr:=Nil;  GraphWin:=Nil;
 
741
 
 
742
  { Will open an hires interlace screen, if you
 
743
    want just an hires screen change HIRESLACE_KEY
 
744
    to HIRES_KEY
 
745
  }
 
746
  thetags[0] := TagItem(SA_Depth,     4);
 
747
  thetags[1] := TagItem(SA_DisplayID, HIRESLACE_KEY);
 
748
  thetags[2].ti_Tag := TAG_END;
 
749
 
 
750
  GraphScr := OpenScreenTagList(NIL,@thetags);
 
751
  If GraphScr=Nil Then begin
 
752
      GraphResultCode := grNoInitGraph;
 
753
      Exit;
 
754
  end;
 
755
 
 
756
  thetags[0] := TagItem(WA_Flags, WFLG_BORDERLESS);
 
757
  thetags[1] := TagItem(WA_IDCMP, IDCMP_MOUSEBUTTONS);
 
758
  thetags[2] := TagItem(WA_CustomScreen, Longint(GraphScr));
 
759
  thetags[3].ti_Tag := TAG_DONE;
 
760
 
 
761
  GraphWin:=OpenWindowTagList(Nil, @thetags);
 
762
  If GraphWin=Nil Then CloseGraph;
 
763
 
 
764
  CurrentRastPort := GraphWin^.RPort;
 
765
 
 
766
  SetColors;
 
767
  TheAspect := GetAspect;
 
768
END;
 
769
 
 
770
PROCEDURE CloseGraph;
 
771
BEGIN
 
772
  { Ende:=false;
 
773
  Repeat
 
774
    Msg:=pIntuiMessage(GetMsg(GraphWin^.UserPort));
 
775
    If Msg<>Nil Then Begin
 
776
      ReplyMsg(Pointer(Msg));
 
777
      Ende:=true;
 
778
    End;
 
779
  Until Ende;}
 
780
  If GraphWin<>Nil Then
 
781
     CloseWindow(GraphWin);
 
782
  If (GraphScr<>Nil) then CloseScreen(GraphScr);
 
783
  if GfxBase <> nil then CloseLibrary(GfxBase);
 
784
  Halt;
 
785
END;
 
786
 
 
787
begin
 
788
 
 
789
  CurX := 0;
 
790
  CurY := 0;
 
791
end.