MODULE C64TOIBM;
(*
Title   : C64TOIBM.MOD
LastEdit: 8/22/88
Author  : Kim Moser
System  : JPI's TopSpeed Modula-2 with PMI's Repertoire 1.5
Descrip : Displays C-64 Doodle file in IBM EGA 200x320 16-color mode
Usage   : C64TOIBM <c64file>

BIOS version

*)

(* JPI *)
FROM SYSTEM IMPORT SIZE, ADR, BYTE, WORD;
FROM IO IMPORT WrCard;

(* Repertoire *)
IMPORT InitJPI;
FROM FileIO IMPORT OpenFile, SetFilePtr, BlockRead, CloseHandle,
  FileOffSet;
FROM StringIO IMPORT ErrorMessage, WriteStr, WriteEol, outp;
FROM EnvironUtils IMPORT ParsedParam;
FROM SmartScreen IMPORT ScreenMode, ScreenModeType;
FROM LowLevel IMPORT ShiftLeft, ShiftRight, Address8086,
  VideoInterrupt, regpack, OutByte, OutWord;
FROM ErrorManager IMPORT WARN;

FROM KbdInput IMPORT KeyHit, AnyKeyNum;

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;

VAR  (* MAIN *)
  Screen: Address8086;

  f: CARDINAL;  (* DOS file handle *)
  C64FileName: ARRAY [0..79] OF CHAR;  (* Arbitrary length *)

  Color: ARRAY [0..24],[0..39] OF BYTE;  (* Color buffer *)
    (* Assumes arrays are mapped by row *)
  Pic: 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 WriteString( s: ARRAY OF CHAR );
BEGIN
  WriteStr( outp, s );
END WriteString;

PROCEDURE WriteLn();
BEGIN
  WriteEol( outp, '' );
END WriteLn;

PROCEDURE WriteStringLn( s: ARRAY OF CHAR );
BEGIN
  WriteEol( outp, s );
END WriteStringLn;


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 HitAnyKey();
VAR
  k: CARDINAL;
BEGIN
  k := KeyHit( AnyKeyNum );
END HitAnyKey;

PROCEDURE WrHex( ch: CHAR );
VAR c: CARDINAL;
BEGIN
  c := ORD(ch);
  IF c < 10 THEN
    WrCard( c, 1 );
  ELSIF c <= 16 THEN
    WriteString( CHR( ORD('A')+c-10 ) );
  ELSE
    WriteString( 'Invalid hex char.' );
    HALT();
  END;
END WrHex;


PROCEDURE ShowUsage();
BEGIN
  WriteStringLn( 'C64TOIBM  v1.0  Copyright (c) 1988 Kim Moser  All Rights Reserved' );
  WriteStringLn( 'Displays C-64 Doodle file in IBM EGA 200x320 16-color mode' );
  WriteStringLn( 'Usage: C64TOIBM <c64filename>' );
END ShowUsage;

PROCEDURE ParseParameters(): BOOLEAN;
(* Returns TRUE if okay, FALSE if any bad params *)
BEGIN
  IF NOT (ParsedParam(1, C64FileName)) THEN
    WriteStringLn( 'Missing parameters.' );
    RETURN FALSE;
  END;

  RETURN TRUE;
END ParseParameters;

PROCEDURE ReadFile(): BOOLEAN;
(* Returns TRUE if able to open, read, and close file, else FALSE *)
  PROCEDURE CloseFile();
  BEGIN
    IF CloseHandle( f ) <> NoError THEN
      WriteLn();
      WriteStringLn( 'Unable to close C-64 file.' );
    END;
  END CloseFile;
VAR
  AnyErrs: BOOLEAN;
BEGIN
  AnyErrs := FALSE;  (* Assume for now *)
  IF OpenFile( f, C64FileName ) <> NoError THEN
    WriteLn();
    WriteString( 'Unable to open C-64 file: ' );
    WriteString( C64FileName );
    RETURN FALSE;  (* Don't try to close file *)
  END;

  SetFilePtr( f, FromStart, VAL(LONGINT,2) );  (* Skip load address *)
  IF BlockRead( f, ADR(Color), SIZE(Color) ) <> NoError THEN;  (* Read color *)
    WriteLn();
    WriteStringLn( 'Internal error: Unable to read color.' );
    AnyErrs := TRUE;
  END;
  SetFilePtr( f, FromCurrent, VAL(LONGINT,24) );  (* Skip load address *)
  IF BlockRead( f, ADR(Pic), SIZE(Pic) ) <> NoError THEN;  (* Read pic *)
    WriteLn();
    WriteStringLn( 'Internal error: Unable to read picture.' );
    AnyErrs := TRUE;
  END;
  IF NOT AnyErrs THEN
    CloseFile();
  END;
  RETURN NOT AnyErrs;
END ReadFile;

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

PROCEDURE DoEGA();
VAR
  Row, Col, x, y: CARDINAL;
  b: bits;
  PixelColor, ForeColor, BackColor: CHAR;
  rgstr: regpack;
BEGIN
(*
  x := 0;
  FOR Row := 0 TO 24 DO
    FOR Col := 0 TO 39 DO
      INC( x );
      WrHex( (HighNibble( Color[Row][Col] )) );
      WrHex( (LowNibble( Color[Row][Col] )) );
      WriteString( ' ' );
      IF x = 16 THEN
        WriteLn;
        x := 0;
      END;
    END;
  END;
  RETURN;

*)

  rgstr.a.h := CHR(12);  (* Write pixel dot *)
  ScreenMode( EGA320 );  (* EGA 200x320, 16 color *)

  FOR Row := 0 TO 24 DO  (* Process all rows *)
    FOR Col := 0 TO 39 DO  (* Process all columns *)
      ForeColor := HighNibble( Color[Row][Col] );
      BackColor := LowNibble( Color[Row][Col] );

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

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

        rgstr.c.x := ( Col*8 );
        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;

          rgstr.a.l := C64ColorMap[ORD(PixelColor)];

          VideoInterrupt( rgstr );

          INC( rgstr.c.x );  (* col *)
        END;
        INC( rgstr.d.x );  (* row *)
      END;
    END;
  END;
END DoEGA;

PROCEDURE LoadSCDFile( fnam: ARRAY OF CHAR );
CONST
  GfxCtrl = 03CEH;
VAR
  s: Address8086;
  mask: CHAR;
BEGIN  (* LoadSCDFile *)
  IF OpenFile( f, fnam ) <> NoError THEN
    WARN( 'Unable to open .SCD file.' );
  END;

  SetFilePtr( f, FromStart, VAL( LONGINT, 16 ) );  (* Skip header *)

  s.seg := 0A000H;
  s.off := 0H;

  OutByte( GfxCtrl, BYTE(ORD(12)) );  (* Pixel value *)
  OutWord( GfxCtrl, WORD(ORD(128+64)) );
  OutWord( GfxCtrl, WORD(ORD(0F01H)) );

  IF BlockRead( f, s.a, 32000 ) <> NoError THEN
    WARN( 'Unable to read .SCR file.' );
  END;

  HitAnyKey();

  IF CloseHandle( f ) <> NoError THEN
    WARN( 'Unable to close .SCD file.' );
  END;

END LoadSCDFile;

PROCEDURE Init();
VAR
  i: CARDINAL;
BEGIN
  (* Initialize: *)
  Screen.seg := 0A000H; (* EGA *)

  (* 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    2 *
    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[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(2);
  C64ColorMap[14] := CHR(9);
  C64ColorMap[15] := CHR(7);
END Init;


BEGIN  (* MAIN *)
  Init();

  ShowUsage();
  IF ParseParameters() & ReadFile() THEN
    (* DoEGA(); *)
  END;

  ScreenMode( EGA320 );  (* EGA 200x320, 16 color *)
  HitAnyKey();
  LoadSCDFile( 'egascrna.scd' );
  
END C64TOIBM.