Pascal: Saving a High-Res picture to a disk file

Pascal graphics does not provide built-in routines to load or save the High-Res
graphics screen to a disk file. The following program illustrates a simple
method for saving and loading any High-Res screen created in a Pascal
environment.

PROGRAM DEMOPIC;
(* *)
(* Program loads and saves high-res screen to disk *)
(* 12/79 based on "SLIDE SHOW" by Bill Atkinson *)
(* *)
USES TURTLEGRAPHICS, APPLESTUFF;
CONST HIRESP1 = 8192;
VAR CHEAT: RECORD CASE BOOLEAN OF
TRUE: (INTPART: INTEGER);
FALSE: (PTRPART:^INTEGER);
END;

PROCEDURE DRAWPICS;
(* *)
(* Draw some stuff on the high-res screen. *)
(* This can be replaced with any graphics routine. *)
(* *)
BEGIN
MOVETO (0,0); PENCOLOR (WHITE);
MOVETO (279,0); MOVETO (279,191);
MOVETO (0,191); MOVETO (0,0);
PENCOLOR (NONE);
MOVETO (75,95); WSTRING (' THIS IS A TEST ');
MOVETO(28,5); WSTRING ('<PRESS RETURN TO EXIT PROGRAM>')
END;

PROCEDURE ERROR;
(* *)
(* If error, program will terminate from here. *)
(* *)
BEGIN
TEXTMODE;
WRITELN ('ERROR ENCOUNTERED - PROGRAM TERMINATED');
EXIT (PROGRAM)
END;

PROCEDURE BLOAD (FILENAME: STRING);
(* *)
(* Blockreads the high-res buffer into memory. *)
(* *)
VAR I,IO: INTEGER;
F: FILE;
BEGIN
CHEAT.INTPART:=HIRESP1;
RESET(F,FILENAME); (* OPEN FILE FOR INPUT *)
(*$I-*)
IO:=BLOCKREAD(F,CHEAT.PTRPART^,16);
I:=IORESULT;
(*$I+*)
CLOSE(F);
IF (I <> 0) OR (IO <> 16) THEN ERROR;
END;

PROCEDURE BSAVE (FILENAME:STRING);
(* *)
(* Saves high-res picture to disk via blockwrite. *)
(* *)
VAR I,IO: INTEGER;
F: FILE;
BEGIN
CHEAT.INTPART:=HIRESP1;
REWRITE (F,FILENAME); (*OPEN NEW DISK FILE FOR OUTPUT*)
(*$I-*)
IO:=BLOCKWRITE (F,CHEAT.PTRPART^,16);
I:=IORESULT;
(*$I+*)
CLOSE (F,LOCK)
IF (I <> 0) OR (IO <> 16) THEN ERROR;
END;

BEGIN (* MAIN PROGRAM *)
INITTURTLE;
DRAWPICS;
BSAVE (':DEMO.PIC');
FILLSCREEN (BLACK); (* Clears high-res screen. *)
BLOAD (':DEMO.PIC');
REPEAT UNTIL KEYPRESS; (* Pause. *)
TEXTMODE
END.