MODULE ViewC64;
(*
Title   : ViewC64.MOD
LastEdit: 11/04/88
Author  : Kim Moser
System  : JPI's TopSpeed Modula-2 with PMI's Repertoire 1.5c
Descrip : Displays C-64 Doodle file in IBM EGA 200x320 16-color mode

Usage   : VIEWC64 <Doodle_filespec> 320x200|640x200 | (640x350 [H]))

          File name may include wildcards.
          EGA mode must be either '640x350' or '640x200' or '320x200'.
          'H' indicates that picture should be half-size (i.e. 1:1
          pixel ratio, but fits in corner of screen).
          Note that 640x350 is the only mode that can be 'halfed'.

12/23/88: Added line in initialization to set C64ColorMap[0] to CHR(0);
          This wasn't done before, resulting in black being mapped to
          a random color.

*)

(* JPI *)
FROM SYSTEM IMPORT SIZE, ADR, BYTE, WORD, Out;
FROM IO IMPORT WrStr, WrLn;

(* Repertoire *)
IMPORT InitJPI;
FROM Drectory IMPORT FileInfoRec, FindFirstFile, FindNextFile;
FROM FileIO IMPORT OpenFile, SetFilePtr, BlockRead, CloseHandle,
  FileExists, CreateFile, BlockWrite, FileOffSet;
FROM StringIO IMPORT ErrorMessage;
FROM EnvironUtils IMPORT ParsedParam;
FROM SmartScreen IMPORT ScreenMode, ScreenModeType, ScreenModeNow;
FROM LowLevel IMPORT ShiftLeft, ShiftRight, Fill;
FROM StrEdit IMPORT AssignStr, Append;
FROM M2Strings IMPORT CompareStr;

FROM KbdInput IMPORT KeyHit, AnyKeyNum;

(* For speed: *)
(*$I-,O-,R-,S-,Z-*)

CONST
  Escape = 27;  (* Ordinal value of escape key *)

TYPE
  bits = RECORD  (* For easy conversion between data types *)
    (* All fields occupy the same 16 bits of storage *)
    CASE a: CARDINAL OF
      1:
        b1: BYTE; b2: BYTE;
    | 2:
        ch1: CHAR; ch2: CHAR;
    | 3:
        s: SET OF [0..15];
    | 4:
        c: CARDINAL;
    | 5:
        w: WORD;
    | 6:
        b: BITSET;
    END;
  END;

(* TYPEs for EGA plot/peek routines: *)
  tinyint      = [0..7];
  bs           = SET OF tinyint;
  bp           = POINTER TO bs;

VAR  (* MAIN *)
  VidSeg: CARDINAL;
  (* SaveRequested: BOOLEAN; *)
  HalfRequested: BOOLEAN;
  RequestedMode: ScreenModeType;  (* What mode requested *)

  (* These vars are set according to the requested mode: *)
  EGAwidth, EGAdepth: CARDINAL;
  BPR: CARDINAL;  (* Bytes-per-row in EGA mode; 40 = 200x320, 80 = all others *)
  multX, multY: CARDINAL;  (* What to multiply x and y by *)
  incX, incY: CARDINAL;
  SideToSide, TopToBottom: BOOLEAN;
    (* Whether pixels should be put next to each other, and on top of each
       other when plotting *)

  OldScreenMode: ScreenModeType;

  (*SaveFileName,*) DoodleFileSpec: ARRAY [0..79] OF CHAR;  (* Arbitrary length *)
  InfoRec: FileInfoRec;

  DoodleColorBuffer: ARRAY [0..24],[0..39] OF BYTE;  (* Color buffer *)
    (* Assumes arrays are mapped by row *)
  DoodlePicBuffer: ARRAY [0..24],[0..39],[0..7] OF BYTE;  (* Picture buffer *)
    (* Assumes arrays are mapped by row *)

  C64ColorMap: ARRAY [0..15] OF CHAR;


(*****************************************************************************
I/O procedures:
*****************************************************************************)

PROCEDURE WrStrLn( s: ARRAY OF CHAR );
BEGIN
  WrStr( s );
  WrLn();
END WrStrLn;

PROCEDURE Usage();
BEGIN
  WrStrLn( 'VIEWC64  v1.0  Copyright (c) 1988 Kim Moser  All Rights Reserved' );
  WrStrLn( 'Displays C-64 Doodle file in EGA mode specified.' );
  WrLn();
  WrStrLn( 'Usage:  VIEWC64 <Doodle_filespec> 320x200|640x200 | (640x350 [H]))' );
END Usage;

PROCEDURE Warn( s: ARRAY OF CHAR );
(* Warn user with message 's' *)
BEGIN
  ScreenMode( OldScreenMode );  (* Restore old screen mode *)
  WrStr( 'VIEWC64: ' );
  WrStrLn( s );
END Warn;

(*****************************************************************************
Graphics procedures:
*****************************************************************************)

PROCEDURE HitAnyKey(): CARDINAL;
VAR
BEGIN
  RETURN KeyHit( AnyKeyNum );
END HitAnyKey;


PROCEDURE Dot( x,y,c : CARDINAL); (* Also VGA *)
(*
CONST
  EGAWidth=320;
  Depth=200;
*)
VAR
  t:bs;
  p,b (*,s*):CARDINAL;
BEGIN
(*   IF (x < EGAWidth) AND (y < Depth) THEN *)
      b := 1 << (7-(x MOD 8));
      p := y*BPR+(x DIV 8);
      Out( 3CEH,8); Out( 3CFH,SHORTCARD(b));
      Out( 3C4H,2);Out( 3C5H,0FH);

(*    s := 0A000H; *)
      t := [VidSeg:p bp]^;
      [VidSeg:p bp]^ := bs{};
      Out( 3C4H,2) ;Out( 3C5H,SHORTCARD(c));
      [VidSeg:p bp]^ := bs{0..7};

      Out( 3CEH,8);Out( 3CFH,0FFH);
      Out( 3C4H,2);Out( 3C5H,0FH);
(*   END; *)
END Dot;

PROCEDURE SelectPlane( p: CARDINAL );
(* Selects EGA plane 'p' [assumes 0<=p<=3] *)
BEGIN
  Out( 3CEH, 4 ); (* read map sel *)
  Out( 3CFH, SHORTCARD(p) );
END SelectPlane;

(* @@@
PROCEDURE Save(): BOOLEAN;
(* Returns TRUE if successfully saved, else FALSE *)
VAR f: CARDINAL;
    p: CARDINAL;
    msg: ARRAY [0..80] OF CHAR;
PROCEDURE CloseFile();
BEGIN
  IF CloseHandle( f ) <> NoError THEN END;
END CloseFile;
BEGIN
  IF FileExists( SaveFileName ) THEN
    AssignStr( 'Save file "', msg );
    Append( msg, SaveFileName );
    Append( msg, '" already exists.' );
    Warn( msg );
    RETURN FALSE;
  END;
  IF CreateFile( f, SaveFileName ) <> NoError THEN
    Warn( 'Unable to create save file.' );
    RETURN FALSE;
  END;
  FOR p := 0 TO 3 DO  (* Write all planes *)
    SelectPlane( p );
    IF BlockWrite( f, [VidSeg:0], BPR*EGAdepth ) <> NoError THEN
      Warn( 'Unable to write plane.' );
      CloseFile();
      RETURN FALSE;
    END;
  END;
  CloseFile();
  RETURN TRUE;
END Save;
*)

(* @@@ Not necessary
PROCEDURE Load();
VAR f: CARDINAL;
    p: CARDINAL;
BEGIN
  IF OpenFile( f, 'pic.ega' ) <> NoError THEN
    Usage( 'Unable to open save file.' );
  ELSE
    FOR p := 0 TO 4 DO
      SelectPlane( p );
      IF BlockRead( f, [s:0], 1000 ) <> NoError THEN
        Usage( 'Unable to read block.' );
      END;
    END;
  END;
  IF CloseHandle( f ) <> NoError THEN
    Usage( 'Unable to close save file.' );
  END;
END Load;
*)

(*
PROCEDURE PeekDot(x,y:CARDINAL) : CARDINAL; (* Also VGA *)
VAR
  t:bs;
  p,b (*,s*):CARDINAL;
  c:CARDINAL;
BEGIN
(*  IF (x < EGAWidth) AND (y < Depth) THEN *)
    b := 1 << (7-(x MOD 8));
    p := y*80+(x DIV 8  );

    Out( 3CEH, 4 ); (* read map sel *)

    Out( 3CFH, 3 );
    t := [VidSeg:p bp]^;
    t := t * bs(b);
    c := CARDINAL( SHORTCARD(t) );

    Out( 3CFH, 2 );
    t := [VidSeg:p bp]^;
    t := t * bs(b);
    c := c * 2 + CARDINAL( SHORTCARD(t) );

    Out( 3CFH, 1 );
    t := [VidSeg:p bp]^;
    t := t * bs(b);
    c := c * 2 + CARDINAL( SHORTCARD(t) );

    Out( 3CFH, 0 );
    t := [VidSeg:p bp]^;
    t := t * bs(b);
    c := c * 2 + CARDINAL( SHORTCARD(t) );

    c := c >> ( 7 - ( x MOD 8 ) );

    RETURN c;
(*
  ELSE
    RETURN 0;
  END;
*)
END PeekDot;
*)


PROCEDURE SetRequestedMode( m: ScreenModeType );
BEGIN
  RequestedMode := m;
  IF m = EGA320 THEN
    BPR:=40;  (* Only for EGA320 *)
  ELSE
    BPR := 80;  (* For all other EGA modes *)
  END;

  CASE m OF
    EGA320:
      multX := 1;
      multY := 1;
      incX := 1;
      incY := 1;
      EGAwidth := 320;
      EGAdepth := 200;
      SideToSide := FALSE;
      TopToBottom := FALSE;
  | EGA640:
      multX := 2;
      multY := 1;
      incX := 2;
      incY := 1;
      EGAwidth := 640;
      EGAdepth := 200;
      SideToSide := TRUE;
      TopToBottom := FALSE;
  | EGA64color:
      multX := 2;
      multY := 2;
      incX := 2;
      incY := 2;
      EGAwidth := 640;
      EGAdepth := 350;
      SideToSide := TRUE;
      TopToBottom := TRUE;
  ELSE
    (* Ignore *)
  END;
END SetRequestedMode;


PROCEDURE HighNibble( b: BYTE ): CHAR;
VAR
  c: bits;
BEGIN
  c.c := 0;              (* 0000000000000000 *)
  c.b2 := b;             (* 00000000abcdefgh *)
  ShiftRight( c.w, 4 );  (* 000000000000abcd *)
  RETURN c.ch2;
END HighNibble;

PROCEDURE LowNibble( b: BYTE ): CHAR;
VAR
  c: bits;
BEGIN
  c.c := 0;             (* 0000000000000000 *)
  c.b2 := b;            (* 00000000abcdefgh *)
  ShiftLeft( c.w, 4 );  (* 0000abcdefgh0000 *)
  c.ch1 := CHR(0);      (* 00000000efgh0000 *)
  ShiftRight( c.w, 4 ); (* 000000000000efgh *)
  RETURN c.ch2;
END LowNibble;

PROCEDURE ReadFile(): BOOLEAN;
(* Returns TRUE if able to open, read, and close file, else FALSE *)
VAR
  ErrMsg: ARRAY [0..80] OF CHAR;
  f: CARDINAL;  (* DOS file handle *)
PROCEDURE CloseFile();
BEGIN
  IF CloseHandle( f ) <> NoError THEN END;
END CloseFile;
BEGIN  (* ReadFile() *)
  IF OpenFile( f, InfoRec.name ) <> NoError THEN
    RETURN FALSE;  (* Don't try to close file *)
  END;

  SetFilePtr( f, FromStart, VAL(LONGINT,2) );  (* Skip load address *)
  IF BlockRead( f, ADR(DoodleColorBuffer), SIZE(DoodleColorBuffer) ) <> NoError THEN;  (* Read color *)
    Warn( 'Unable to read color (possibly non-Doodle file).' );
    CloseFile();
    RETURN FALSE;
  END;
  SetFilePtr( f, FromCurrent, VAL(LONGINT,24) );  (* Skip load address *)
  IF BlockRead( f, ADR(DoodlePicBuffer), SIZE(DoodlePicBuffer) ) <> NoError THEN;  (* Read pic *)
    Warn( 'Unable to read picture (possibly non-Doodle file).' );
    CloseFile();
    RETURN FALSE;
  END;
  CloseFile();
  RETURN TRUE;
END ReadFile;

(*****************************************************************************
Main graphics procedures:
*****************************************************************************)

PROCEDURE DoEGA();
VAR
  Row, Col, x, y: CARDINAL;
  b: bits;
  PixelColor, ForeColor, BackColor: CHAR;
  theX, theY: CARDINAL;  (* Absolute col and row of dot *)
  ColorCard: CARDINAL;
BEGIN
(*
  Out( 3CEH,8);
  Out( 3C4H,2);Out( 3C5H,0FH);
*)
  FOR Row := 0 TO 24 DO  (* Process all rows *)
    FOR Col := 0 TO 39 DO  (* Process all columns *)
      ForeColor := HighNibble( DoodleColorBuffer[Row][Col] );
      BackColor := LowNibble( DoodleColorBuffer[Row][Col] );

      FOR y := 0 TO 7 DO  (* Process all 'lines' *)
        b.b1 := DoodlePicBuffer[Row][Col][y];  (* abcdefgh00000000 *)

        (* 0 <--- 7 15 --> 8
           xxxxxxxx xxxxxxxx *)

        theY := (Row*8 + y) * multY;
        IF (RequestedMode = EGA64color) AND (NOT HalfRequested) THEN
          DEC( theY, (Row*8+y+1) DIV 4 );
        END;
        theX := Col*8 * multX;
        FOR x := 0 TO 7 DO  (* Process all pixels per 'line' *)
          IF ((7-x) IN b.s) THEN
            (* Use foreground color *)
            PixelColor := ForeColor;
          ELSE
            (* Use background color *)
            PixelColor := BackColor;
          END;

          ColorCard := ORD( C64ColorMap[ORD(PixelColor)] );

          Dot( theX, theY, ColorCard );

          IF SideToSide THEN  (* Plot them side-by side *)
            Dot( theX+1, theY, ColorCard );
          END;

          IF NOT ( (RequestedMode=EGA64color) AND (NOT HalfRequested) AND
                   (((Row*8+y+1+1) MOD 4)=0) ) THEN
            IF TopToBottom THEN
              (* Plot them top-to-bottom *)
              Dot( theX, theY+1, ColorCard );
            END;

            IF SideToSide AND TopToBottom THEN
              Dot( theX+1, theY+1, ColorCard );
            END;
          END;

          INC( theX, incX );

        END;
      END;
    END;
  END;
  (*
  Out( 3CEH,8);Out( 3CFH,0FFH);
  Out( 3C4H,2);Out( 3C5H,0FH);
  *)
END DoEGA;

PROCEDURE Init();
VAR
  i: CARDINAL;
BEGIN
  (* Initialize: *)

  (* Normal colors:

     #  C64               IBM              IBM equivalent
    --  -----             -----            --------------
     0  black             black            0 +
     1  white             blue             15
     2  red               green            4
     3  cyan              cyan             3
     4  purple            red              5
     5  green             magenta          2
     6  blue              brown            1
     7  yellow            light grey       14
     8  orange            dark grey        12 &
     9  brown             light blue       6
    10  light red (pink)  light green      12 &
    11  gray 1            light cyan       0 +
    12  gray 2            light red        7 %
    13  light green       light magenta    10
    14  light blue        yellow           9
    15  gray 3            bright white     7 %

  *)

(*
  (* Init default C64 color map: *)
  FOR i := 0 TO 15 DO
    C64ColorMap[i] := CHR(i);
  END;
*)

  C64ColorMap[0] := CHR(0);
  C64ColorMap[1] := CHR(15);
  C64ColorMap[2] := CHR(4);
  C64ColorMap[3] := CHR(3);
  C64ColorMap[4] := CHR(5);
  C64ColorMap[5] := CHR(2);
  C64ColorMap[6] := CHR(1);
  C64ColorMap[7] := CHR(14);
  C64ColorMap[8] := CHR(12);
  C64ColorMap[9] := CHR(6);
  C64ColorMap[10] := CHR(12);
  C64ColorMap[11] := CHR(0);
  C64ColorMap[12] := CHR(7);
  C64ColorMap[13] := CHR(10);
  C64ColorMap[14] := CHR(9);
  C64ColorMap[15] := CHR(7);

  OldScreenMode := ScreenModeNow;  (* Save screen mode *)
  (* SaveRequested := FALSE;  (* Default *) *)
  HalfRequested := FALSE;  (* Default *)
  VidSeg := 0A000H;
  SetRequestedMode( EGA320 );  (* Default *)
END Init;

PROCEDURE ParseParams(): BOOLEAN;
(* Returns TRUE if all params okay, else FALSE *)
VAR
  param2, param3: ARRAY [0..80] OF CHAR;
BEGIN
  IF NOT ( ParsedParam(1,DoodleFileSpec) AND ParsedParam(2,param2) ) THEN
    (* Filespec and mode not specified *)
    RETURN FALSE;
  END;
  IF CompareStr( param2, '640x200' )=0 THEN
    SetRequestedMode( EGA640 );
  ELSIF CompareStr( param2, '320x200' )=0 THEN
    SetRequestedMode( EGA320 );
  ELSIF CompareStr( param2, '640x350' )=0 THEN
    SetRequestedMode( EGA64color );
  ELSE
    (* Bad video mode *)
    RETURN FALSE;
  END;
  HalfRequested := ( ParsedParam( 3, param3 ) AND (CAP(param3[0])='H') );
  IF HalfRequested THEN
    IF (CompareStr(param2,'640x350')=0) THEN
      (* Half requested, so set appropriate stuff: *)
      incX := 1;
      incY := 1;
      multX := 1;
      multY := 1;
      SideToSide := FALSE;
      TopToBottom := FALSE;
    ELSE
      (* Half requested, but mode requested was not 640x350 *)
      RETURN FALSE;
    END;
  END;
  (* SaveRequested := ParsedParam( i, SaveFileName ); *)
  RETURN TRUE;
END ParseParams;

PROCEDURE ClearPage();
VAR p: CARDINAL;
BEGIN
  FOR p := 0 TO 3 DO  (* Clear all planes *)
    SelectPlane( p );
    Fill( [VidSeg:0], BPR*EGAdepth, BYTE(0) );
  END;
END ClearPage;

BEGIN  (* MAIN *)
  Init();
  IF NOT ParseParams() THEN
    Usage();
  ELSE
    IF FindFirstFile( DoodleFileSpec, InfoRec ) = NoMoreFiles THEN
      Warn( 'Unable to find C-64 file.' );
      RETURN;
    END;
    LOOP
      (* Process all files *)
      IF NOT ReadFile() THEN
        (* If this happens, it means that ReadFile() encountered a non-Doodle
           file, or had some other problem reading the file.  The file
           SHOULD exist, though, since FindFirstFile() and FindNextFile()
           makes sure it does. *)
        EXIT;
      END;
      ScreenMode( RequestedMode );
  
      DoEGA();
      CASE HitAnyKey() OF
        Escape, ORD('q'), ORD('Q'):
          EXIT;
        ELSE
          (* Do nothing *)
      END;
      ClearPage();
    (* DoIt(); *)
(* @@@
    IF SaveRequested THEN
      IF Save() THEN
        Warn( 'Picture saved.' );
        (* No ELSE clause needed because Save() warns if unable to
           save picture. *)
      END;
    END;
*)
      IF FindNextFile( InfoRec ) = NoMoreFiles THEN EXIT END;
    END;
    ScreenMode( OldScreenMode );  (* Restore old screen mode *)
  END;
END ViewC64.