(*
Title   : MakeNDX.MOD
Author  : Kim Moser
System  : JPI's TopSpeed Modula-2 with PMI's Repertoire 1.5
Descrip : Reads 320x200 Doodle pictures, adds them to an .NDX as an
          EGA image.
Usage   : MAKENDX <Doodle_Filename> <NDX_Record_name>
*)

MODULE MakeNDX;

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

(* Repertoire *)
IMPORT InitJPI;
FROM VStorage IMPORT DosAlloc, DosDealloc;
FROM MemCompress IMPORT ErrorFlag, CompressError, Compress, Decompress;
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, AddAddr, Move;
FROM StrEdit IMPORT AssignStr, Append;
FROM M2Strings IMPORT CompareStr;

FROM NdxBones IMPORT NdxFileType, OpenNdxFile, Retrieve, FindRecord;
FROM NdxFiles IMPORT CreateNdxFile, CloseNdxFile, PutField, PutFieldAdr,
  WriteRecord;

FROM KbdInput IMPORT KeyHit, AnyKeyNum;

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

CONST
  Escape = 27;  (* Ordinal value of escape key *)
  Structure = 'TheName, TheImage';
  NdxFileName = 'SS.NDX';

  KeyFieldCode = 8;
  CompressedPictureCode = 88;


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 *)
  NdxFile: NdxFileType;
  VidSeg: CARDINAL;
  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;

  DoodleFileSpec, RecordName: 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( 'MAKENDX  v1.0  Copyright (c) 1988 Kim Moser  All Rights Reserved' );
  WrStrLn( 'Reads 320x200 Doodle pictures, adds them to an .NDX as an EGA image.' );
  WrLn();
  WrStrLn( 'Usage:  MAKENDX <Doodle_Filename> <NDX_Record_name>' );
END Usage;

PROCEDURE Warn( s: ARRAY OF CHAR );
(* Warn user with message 's' *)
BEGIN
  ScreenMode( OldScreenMode );  (* Restore old screen mode *)
  WrStr( 'MAKENDX: ' );
  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 *)
CONST
  TmpFileName = 'e:\TMP.$$$';
VAR
  outSize: CARDINAL;  (* How much memory used by compressed planes *)
  p: CARDINAL;
  AllFourPlanes, CompressedPlanes: ADDRESS;
  TmpFile: CARDINAL;
(*
  PROCEDURE Compress(InAddress: ADDRESS; InSize:
      CARDINAL; VAR OutAddress: ADDRESS; VAR OutSize:
      CARDINAL; OutAlloc: BOOLEAN): BOOLEAN;

  PROCEDURE Decompress(InAddress: ADDRESS; InSize:
      CARDINAL; OutAddress: ADDRESS; OutSize:
      CARDINAL);
*)
PROCEDURE CloseFile();
BEGIN
  CloseNdxFile( NdxFile );
END CloseFile;
BEGIN
  IF NOT OpenNdxFile( NdxFile, NdxFileName ) THEN
    CreateNdxFile( NdxFile, NdxFileName, Structure );
  END;

  IF CreateFile( TmpFile, TmpFileName ) <> NoError THEN
    Warn( 'Unable to create temp file.' );
  END;

  (* Write all 4 blocks to tempfile: *)
  FOR p := 0 TO 3 DO
    SelectPlane( p );
    IF BlockWrite( TmpFile, [VidSeg:0], BPR*EGAdepth ) <> NoError THEN
      Warn( 'Unable to write plane to temp file.' );
    END;
  END;
  IF CloseHandle( TmpFile ) <> NoError THEN
    Warn( 'Unable to close temp file after writing.' );
  END;

  DosAlloc( AllFourPlanes, BPR*EGAdepth * 4 );

  (* Read back temp file: *)
  IF OpenFile( TmpFile, TmpFileName ) <> NoError THEN
    Warn( 'Unable to open temp file.' );
  END;
  IF BlockRead( TmpFile, AllFourPlanes, BPR*EGAdepth * 4 ) <> NoError THEN
    Warn( 'Unable to read temp file.' );
  END;
  IF CloseHandle( TmpFile ) <> NoError THEN
    Warn( 'Unable to close temp file after reading.' );
  END;

  outSize := BPR*EGAdepth * 4;

(*
  DosAlloc( CompressedPlanes, BPR*EGAdepth * 4 );
  IF NOT Compress( AllFourPlanes, BPR*EGAdepth * 4, CompressedPlanes,
                   outSize, TRUE ) THEN
    Warn( 'Unable to compress.' );
  END;

  (* We no longer need the uncompressed planes: *)
  DosDealloc( AllFourPlanes, BPR*EGAdepth * 4);
*)

  IF NOT PutField( NdxFile, RecordName, 'TheName', KeyFieldCode, RecordName ) THEN
    Warn( 'Unable to perform PutField() on key.' );
  END;
  IF NOT PutFieldAdr( NdxFile, RecordName, 'TheImage', CompressedPictureCode,
           AllFourPlanes, outSize ) THEN
    Warn( 'Unable to perform PutField() om image.' );
  END;

  IF NOT WriteRecord( NdxFile, RecordName ) THEN
    Warn( 'Unable to perform WriteRecord()' );
  END;

  (* DO NOT DEALLOCATE AllFourPlanes since it's been absorbed into the
     NdxFile's buffer.  The NdxFiles module will take care of deallocating
     it! *)
  CloseFile();

  RETURN TRUE;
END Save;

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[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 i: CARDINAL;
    Str: ARRAY [0..80] OF CHAR;
BEGIN
  IF NOT ( ParsedParam(1,DoodleFileSpec) AND ParsedParam(2,RecordName) ) THEN
    (* Filespec and record name not specified *)
    RETURN FALSE;
  END;
  (* In case name is more than 1 word long: *)
  i := 3;
  WHILE ParsedParam( i, Str ) DO
    Append( RecordName, ' ' );
    Append( RecordName, Str );
    INC( i );
  END;
  SetRequestedMode( EGA320 );
  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;
      IF Save() THEN
        Warn( 'Picture saved.' );
        (* No ELSE clause needed because Save() warns if unable to
             save picture. *)
      END;
      EXIT;
    END;
    ScreenMode( OldScreenMode );  (* Restore old screen mode *)
  END;

END MakeNDX.