(* GRAPHIC.PAS -- graphic stuff
** Copyright (c) 1995,1996 Jochen Metzinger
**
** This program is free software; you can redistribute it and/or modify
** it under the terms of the GNU General Public License as published by
** the Free Software Foundation; either version 2, or (at your option)
** any later version.
**
** This program is distributed in the hope that it will be useful,
** but WITHOUT ANY WARRANTY; without even the implied warranty of
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
** GNU General Public License for more details.
**
** You should have received a copy of the GNU General Public License
** along with this program; if not, write to the Free Software
** Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*)

UNIT graphic;

INTERFACE

USES Crt, Dos, Graph, global, errors;

CONST
 VGA_MAXX = 639;
 VGA_MAXY = 479;
  (* use VGA mode VGAHi *)
 BGI_PATH = 'C:\TP\BGI';
  (* default path to driver EGAVGA.BGI *)

TYPE
 ColorPal = (EGAcp, CBMcp);
  (* which color palette *)

PROCEDURE OpenGraphic(p: ColorPal);
(* Open graphic mode VGAHi *)

PROCEDURE CloseGraphic(wait_key: BOOLEAN);
(* CloseGraph() with optional waiting for a key pressed *)

PROCEDURE GetColorPalette(p: ColorPal; VAR pal);
(* Store RGBPalette of "p" in "pal" *)

PROCEDURE TextOut(s: STRING);
(* output "s" at bottom graphic line *)

PROCEDURE G_FATAL(msg: STRING);
(* for FATAL errors within graphic mode *)

PROCEDURE G_err_stop;
(* for FATAL errors within graphic mode *)

PROCEDURE ScrollUp(x1, y1, x2, y2: INTEGER; lines: WORD);
(* scroll up graphic window *)

IMPLEMENTATION

TYPE
 ColorPaletteType =
  RECORD
   text, black: BYTE;
   rgb: ARRAY [0..MaxColors] OF RECORD r, g, b: BYTE END;
  END;

CONST
 ColorPalette: ARRAY [ColorPal] OF ColorPaletteType =
  ((* EGAcp *)
   (text:  7; (* LightGray *)
    black: 0;
    rgb: ((r:$00;g:$00;b:$00), (r:$00;g:$00;b:$AA),
          (r:$00;g:$AA;b:$00), (r:$00;g:$AA;b:$AA),
          (r:$AA;g:$00;b:$00), (r:$AA;g:$00;b:$AA),
          (r:$AA;g:$55;b:$00), (r:$AA;g:$AA;b:$AA),
          (r:$55;g:$55;b:$55), (r:$55;g:$55;b:$FF),
          (r:$55;g:$FF;b:$55), (r:$55;g:$FF;b:$FF),
          (r:$FF;g:$55;b:$55), (r:$FF;g:$55;b:$FF),
          (r:$FF;g:$FF;b:$55), (r:$FF;g:$FF;b:$FF))),
   (* CBMcp *)
   (text: 15; (* lt gey *)
    black: 0;
    rgb: ((r:$00;g:$00;b:$00), (r:$FF;g:$FF;b:$FF),
          (r:$FF;g:$00;b:$00), (r:$00;g:$FF;b:$FF),
          (r:$FF;g:$00;b:$FF), (r:$00;g:$FF;b:$00),
          (r:$00;g:$00;b:$FF), (r:$FF;g:$FF;b:$00),
          (r:$FF;g:$66;b:$00), (r:$AA;g:$44;b:$00),
          (r:$FF;g:$77;b:$77), (r:$55;g:$55;b:$55),
          (r:$88;g:$88;b:$88), (r:$99;g:$FF;b:$99),
          (r:$99;g:$99;b:$FF), (r:$BB;g:$BB;b:$BB))));

VAR cp: ColorPal;
    graphic_on: BOOLEAN;

PROCEDURE InitGraphic;
 VAR GraphDriver, GraphMode, ErrorCode, i: INTEGER;
  path: PathStr; D: DirStr; N: NameStr; E: ExtStr;
BEGIN
 FOR i := 1 TO 4 DO
  BEGIN (* try 4 paths *)
   GraphDriver := VGA;
   GraphMode := VGAHi;
   CASE i OF
    1: path := GetEnv('BGI');
    2: path := BGI_PATH;
    3: BEGIN
        FSplit(ParamStr(0), D, N, E);
        path := D;
       END;
    4: path := '.';
   END; (* case *)
   InitGraph(GraphDriver,GraphMode, path);
   ErrorCode := GraphResult;
   IF ErrorCode = grOK THEN BEGIN
    graphic_on := TRUE;
    SetTextJustify(LeftText, BottomText);
    EXIT;
   END; (* if *)
   IF ErrorCode <> grFileNotFound  THEN
    FATAL(GraphErrorMsg(ErrorCode));
  END; (* for *)
 FATAL(GraphErrorMsg(ErrorCode));
END; (* InitGraphic *)

PROCEDURE OpenGraphic(p: ColorPal);
 VAR Palette: PaletteType; i: INTEGER;
BEGIN
 InitGraphic;
 GetPalette(Palette);
 cp := p;
 WITH Palette, ColorPalette[cp] DO
  FOR i := 0 TO Size-1 DO
   WITH rgb[i] DO
    SetRGBPalette(Colors[i], r SHR 2, g SHR 2, b SHR 2);
END; (* SetRGBColors *)

PROCEDURE GetColorPalette(p: ColorPal; VAR pal);
 VAR pl: ARRAY [0..47] OF BYTE ABSOLUTE pal;
  i: BYTE;
BEGIN
 FOR i := 0 TO 15 DO
  WITH ColorPalette[p].rgb[i] DO BEGIN
   pl[3*i+0] := r;
   pl[3*i+1] := g;
   pl[3*i+2] := b;
  END; (* with *)
END; (* GetColorPalette *)

PROCEDURE CloseGraphic(wait_key: BOOLEAN);
BEGIN
 IF wait_key THEN BEGIN
  TextOut('<<Press a key to continue>>');
  REPEAT UNTIL ReadKey <> #0;
 END; (* if *)
 Graph.CloseGraph;
 graphic_on := FALSE;
END; (* CloseGraphic *)

PROCEDURE G_FATAL(msg: STRING);
BEGIN
 IF graphic_on THEN BEGIN
  TextOut('ERROR: ' + msg);
  REPEAT UNTIL ReadKey <> #0;
  Graph.CloseGraph;
 END; (* if *)
 FATAL(msg);
END; (* G_FATAL *)

PROCEDURE G_err_stop;
 VAR err_msg: STRING;
BEGIN
 IF is_err THEN BEGIN
  IF graphic_on THEN BEGIN
   err_msg := get_error;
   TextOut(err_msg);
   REPEAT UNTIL ReadKey <> #0;
   Graph.CloseGraph;
  END; (* if *)
  WriteLn(err_msg);
  HALT(1);
 END; (* if *)
END; (* G_err_stop *)

PROCEDURE ScrollUp(x1, y1, x2, y2: INTEGER; lines: WORD);
 VAR h, y: INTEGER; size: WORD; p: POINTER;
BEGIN
 IF lines = 0 THEN EXIT;
 (* coordinates within graphic screen *)
 IF x1 < 0 THEN x1 := 0; IF x1 > VGA_MAXX THEN x1 := VGA_MAXX;
 IF y1 < 0 THEN y1 := 0; IF y1 > VGA_MAXY THEN y1 := VGA_MAXY;
 IF x2 < 0 THEN x2 := 0; IF x2 > VGA_MAXX THEN x2 := VGA_MAXX;
 IF y2 < 0 THEN y2 := 0; IF y2 > VGA_MAXY THEN y2 := VGA_MAXY;
 (* upper left corner z1 *)
 IF x1 > x2 THEN BEGIN h := x1; x1 := x2; x2 := h; END;
 IF y1 > y2 THEN BEGIN h := y1; y1 := y2; y2 := h; END;
 (* can only lines in window *)
 IF lines > y2 - y1 THEN lines := y2 - y1;
 (* get one line buffer *)
 GetMem(p, ImageSize(x1, 0, x2, 0));
 (* scroll up *)
 FOR y := y1 + lines TO y2 DO BEGIN
  GetImage(x1, y, x2, y, p^);
  PutImage(x1, y-lines, p^, NormalPut);
 END; (* for *)
 (* clear new lines *)
 FOR y := y2-lines TO y2 DO BEGIN
  GetImage(x1, y, x2, y, p^);
  PutImage(x1, y, p^, XorPut);
 END; (* for *)
END; (* ScrollUp *)

PROCEDURE TextOut(s: STRING);
BEGIN
 SetFillStyle(SolidFill, Black);
 Bar(0, VGA_MAXY-8, VGA_MAXX, VGA_MAXY);
 SetColor(ColorPalette[cp].text);
 SetTextJustify(LeftText, BottomText);
 OutTextXY(0,VGA_MAXY,s);
END; (* TextOut *)

PROCEDURE ExitProcedure;
(* called after before terminating program *)
BEGIN
 (* normal termination? *)
 IF ErrorAddr = NIL THEN
  HALT(ExitCode);
 (* fatal run-time error *)
 IF graphic_on THEN Graph.CloseGraph;
 IF source = '' THEN Write('FATAL: ') ELSE Write(source,': ');
 (* too few memory? *)
 IF ExitCode = 203 THEN BEGIN
  WriteLn('Heap overflow');
  HALT(4);
 END; (* if *)
 Write('INTERN [Run-time error ',ExitCode,' at ');
 WriteLn(HexStr(Seg(ErrorAddr^),4),':',HexStr(Ofs(ErrorAddr^),4),']');
 HALT(3);
END; (* ExitProcedure *)

BEGIN
 cp := EGAcp;
 graphic_on := FALSE;
 ExitProc := @ExitProcedure;
END. (* graphic *)