{
*******************************************************
*                                                     *
* Title:       PRINTMASTER GALLERY                    *
* Author:      MARK SNOOK                             *
* Last Update: 27/1/90                                * 
* Requires:    GALLERY.HEX                            *
*              SLIB.SDR                               *
*              SLIB.SHP                               *
* Notes:       The above files must be on the same    *
*              drive as the compiled .COM program.    *
*              This was written for Hisoft Devpac80.  *
*                                                     *                
* This is a program written to read the PRINTMASTER   *
* library file SLIB.SHP and to display the pictures.  *
*                                                     *
*******************************************************
}
{$y,l-,c-,vBFFF} { Locate below common ram at #C000 }

PROGRAM PMGallery(INPUT,OUTPUT);

CONST
  LibFile  = '  slib    .shp'; {file of picture data }
  NameFile = '  slib    .sdr'; {file of picture names}
  HexFile  = '  gallery .hex'; {file of machine code }
  RecSize  = 577;              {record size of a picture}
  MaxMenuLen   = 28;
  MaxMenuWidth = 16;
  NumPics      = 124;
  Return       = CHR(13); 
  UpArrow      = CHR(11); {control-K}
  DownArrow    = CHR(10); {control-J}
  Can          = CHR(8);  {control-H}
  DelLeft      = CHR(127);

TYPE

  MenuOption = ARRAY [1..MaxMenuWidth] OF CHAR;
  MenuList   = ARRAY [1..MaxMenuLen] OF MenuOption;
  Gallery    = ARRAY [0..NumPics] OF MenuOption;
  
  PicRec = RECORD
             w,h,d1,d2:CHAR;
             Pic:ARRAY[0..571] OF CHAR;
             Term:CHAR;
           END;

VAR
  MCFile,PicLib,PicMenu:TEXT;
  Letters,Punct:SET OF CHAR;
  PicList:Gallery;
 

{================== SCREEN ROUTINES ===================}

PROCEDURE StatusOff;

  VAR
    dummy : INTEGER;

  BEGIN
    dummy:=CPM(2,27);
    dummy:=CPM(2,ORD('0'))
  END;

{======================================================}

PROCEDURE StatusOn;

  VAR
    dummy : INTEGER;

  BEGIN
    dummy:=CPM(2,27);
    dummy:=CPM(2,ORD('1'))
  END;

{======================================================}

PROCEDURE CursorOff;

  VAR
    dummy : INTEGER;

  BEGIN
    dummy:=CPM(2,27);
    dummy:=CPM(2,ORD('f'))
  END;

{======================================================}

PROCEDURE CursorOn;

  VAR
    dummy : INTEGER;

  BEGIN
    dummy:=CPM(2,27);
    dummy:=CPM(2,ORD('e'))
  END;

{======================================================}

PROCEDURE GotoXY(col,row:INTEGER);

  VAR
    dummy : INTEGER;

  BEGIN
    dummy:=CPM(2,27);
    dummy:=CPM(2,ORD('Y'));
    dummy:=CPM(2,row+32);
    dummy:=CPM(2,col+32)
  END;

{======================================================}

PROCEDURE Window(Col,Row,Height,Width:INTEGER);

  VAR
    dummy:INTEGER;

  BEGIN
    dummy:=CPM(2,27);
    dummy:=CPM(2,ORD('X'));
    dummy:=CPM(2,Row+32);
    dummy:=CPM(2,Col+32);
    dummy:=CPM(2,Height+31);
    dummy:=CPM(2,Width+31)
  END;

{======================================================}

PROCEDURE FullScreen;

  VAR
    dummy:INTEGER;

  BEGIN
    dummy:=CPM(2,27);
    dummy:=CPM(2,ORD('X'));
    dummy:=CPM(2,32);
    dummy:=CPM(2,32);
    dummy:=CPM(2,31+31);
    dummy:=CPM(2,90+31)
  END;

{======================================================}

PROCEDURE CLS;

  VAR
    dummy : INTEGER;

  BEGIN
    dummy:=CPM(2,27);
    dummy:=CPM(2,ORD('E'))
  END; 

{======================================================}

PROCEDURE CursorUp;

  VAR
    dummy : INTEGER;

  BEGIN
    dummy:=CPM(2,27);
    dummy:=CPM(2,ORD('A'))
  END; 

{======================================================}

PROCEDURE CursorDown;

  VAR
    dummy : INTEGER;

  BEGIN
    dummy:=CPM(2,27);
    dummy:=CPM(2,ORD('B'))
  END; 

{======================================================}

PROCEDURE CursorLeft;

  VAR
    dummy : INTEGER;

  BEGIN
    dummy:=CPM(2,27);
    dummy:=CPM(2,ORD('D'))
  END; 

{======================================================}

PROCEDURE CursorRight;

  VAR
    dummy : INTEGER;

  BEGIN
    dummy:=CPM(2,27);
    dummy:=CPM(2,ORD('D'))
  END; 

{========== FILE READING PROCEDURES ===================}

{ READRAND is a function which returns TRUE if a record can not be found
  on the disc. It returns FALSE if the data was read successfully.
  The first parameter is the Text File variable you wish to read. This should
  be opened using RESET (or REWRITE if you use WRITERAND on it first).
  The second parameter is the File Component you wish to read starting from 0.
  The third parameter is the address of the variable you wish to read.
  The fourth parameter is the size (in bytes) of the file components.
}

FUNCTION ReadR(VAR F:TEXT;I,B:INTEGER):INTEGER;

VAR Dum:INTEGER;
BEGIN
  POKE(ADDR(F)+40,I);POKE(ADDR(F)+42,CHR(0));
  Dum:=CPM(26,B);           { Set DMA address }
  ReadR:=CPM(33,ADDR(F)+7); { Random read }
END;

FUNCTION ReadRand(VAR F:TEXT;LogRec,Adr,Nbytes:INTEGER):BOOLEAN;

VAR
  ByteNo:REAL;
  Valid,Snum,Offset,Start,i:INTEGER;
  NoMore:BOOLEAN;
  b: ARRAY[1..128] OF CHAR;

BEGIN
  ByteNo:=LogRec * Nbytes;
  Snum:=ENTIER(ByteNo/128);
  Offset:=ROUND(ByteNo-Snum*128);
  Start:=0;
  NoMore:=FALSE;
  REPEAT
    IF READR(F,Snum,ADDR(b)) <> 0 THEN NoMore:=TRUE
    ELSE
    BEGIN
      IF Offset+Nbytes-Start>128 THEN Valid:=128-Offset
			  ELSE Valid:=Nbytes-Start;
     FOR i:=0 TO Valid-1 DO POKE(Adr+Start+i,b[Offset+1+i]);
     Start:=Start+Valid;
     Snum:=Snum+1;Offset:=0;
    END
  UNTIL (Start=Nbytes) OR NoMore; 
  ReadRand:=nomore;
END;

{============== LOAD MACHINE CODE =====================}

PROCEDURE LoadHex;

VAR
  Posn:INTEGER;
  NotGotByte:BOOLEAN;
  Buff:CHAR;

BEGIN
  RESET(MCFile,HexFile);
  FOR Posn:=#0 TO #47 DO
    BEGIN
      NotGotByte:=ReadRand(MCFile,Posn,ADDR(Buff),1);
      POKE(#C000+Posn,Buff);
      IF NotGotByte THEN Write('Transfer not complete',Posn:4:H)
    END
END;

{============== MENU PROCEDURES =======================}

PROCEDURE PrintRow(Width,StartChar,EndChar,MiddleChar:INTEGER);

  VAR
    n : INTEGER;

  BEGIN
    WRITE(CHR(StartChar));
    FOR n:= 1 TO Width DO WRITE(CHR(MiddleChar));
    WRITE(CHR(EndChar))
  END;

{======================================================}

PROCEDURE DrawBorder(x,y,Width,Length:INTEGER);

  VAR
    n : INTEGER;

  BEGIN
    GotoXY(x,y);
    PrintRow(Width,134,140,138);
    FOR n:= 1 TO Length DO
      BEGIN
        GotoXY(x,y+n);
        Write(CHR(133));
        GotoXY(x+Width+1,y+n);
        Write(CHR(133))
      END;
    GotoXY(x,y+n);
    PrintRow(Width,131,137,138);
    GotoXY(x+1,y+1)
  END;

{======================================================}

PROCEDURE ReverseVideo;

  VAR
    dummy : INTEGER;
	
  BEGIN
    dummy:=CPM(2,27);
    dummy:=CPM(2,ORD('p'))
  END;


PROCEDURE NormalVideo;

  VAR
    dummy : INTEGER;
	
  BEGIN
    dummy:=CPM(2,27);
    dummy:=CPM(2,ORD('q'))
  END;

{======================================================}
 
PROCEDURE MenuChoice(x,y,Width,Length:INTEGER;Choices:MenuList;
                     VAR Val:INTEGER;Redraw:BOOLEAN);

  VAR
    n,m:INTEGER;
    Key,Letter:CHAR;

  PROCEDURE WriteNormal;
    BEGIN
      GotoXY(x+1,y+Val);
      NormalVideo;
      FOR m:=1 TO Width DO
        BEGIN
          Letter:=Choices[Val][m];
          IF Letter = CHR(0) THEN Letter:=' ';
          WRITE(Letter)
        END
    END;

  PROCEDURE WriteReverse;
    BEGIN
      GotoXY(x+1,y+Val);
      ReverseVideo;
      FOR m:=1 TO Width DO
        BEGIN
          Letter:=Choices[Val][m];
          IF Letter = CHR(0) THEN Letter:=' ';
          WRITE(Letter)
        END
    END;

  BEGIN
    IF Redraw THEN
      BEGIN
        DrawBorder(x,y,Width,Length);
        FOR n:= 1 TO Length DO
          BEGIN
            GotoXY(x+1,y+n);
            FOR m:=1 TO Width DO WRITE(Choices[n][m])
          END
      END;
    IF Val > 0 THEN BEGIN
    WriteReverse;
    Key:=INCH;
    WHILE (Key <> Return) AND (Key <> Can) DO
      BEGIN
        IF Key = DownArrow THEN
          BEGIN
            WriteNormal;
            Val:=Val+1;
            IF Val > Length THEN Val:=1;
            WriteReverse
          END;
				IF Key = UpArrow THEN
          BEGIN
            WriteNormal;
            Val:=Val-1;
            IF Val < 1 THEN Val:=Length;
						WriteReverse
					END;
				Key:=INCH
			END;
    IF Key = Can THEN Val:=0
    END;
    NormalVideo;
	END;

{======================================================}

PROCEDURE EraseMenu;

BEGIN
  Window(0,0,31,18);
  CLS;
  Window(0,0,31,90)
END;

{================== END OF MENU PROCEDURES ============}

PROCEDURE Initialise;

BEGIN
  DrawBorder(29,0,40,1);
  GotoXY(31,1);
  Write('P R I N T M A S T E R    G A L L E R Y');
  GotoXY(36,5);
  Write('Hit [CAN] to return to CP/M')
END;

{======================================================}
PROCEDURE GetMenu;

VAR
  Count:INTEGER;
  NotGotPic:BOOLEAN;

BEGIN
  RESET(PicMenu,NameFile);
  FOR Count:= 0 TO NumPics DO
    BEGIN
      NotGotPic:=READRAND(PicMenu,Count,ADDR(PicList[Count]),MaxMenuWidth);
			IF NotGotPic THEN WRITE('No entry in MenuFile for number ',Count)
    END
END;

{======================================================}

PROCEDURE PlotByte(x,y,data:CHAR);

 
BEGIN
  POKE(#C000,x);
  POKE(#C001,y);
  POKE(#C002,data);
  USER(#C003)    {Call machine code plot routine}
END;

{======================================================}

PROCEDURE PlotPic(tlx,tly,PicNum:INTEGER);

VAR
  x,y,NumBytes:INTEGER;
  Symbol:PicRec;
  NotGotRec:BOOLEAN;
  Byte:CHAR;

BEGIN
  RESET(PicLib,LibFile);
  NotGotRec:=READRAND(PicLib,PicNum,ADDR(Symbol),RecSize);
  
  IF NotGotRec THEN WRITE('Picture not found with record number ',PicNum)
  ELSE FOR y:=0 TO 51 DO
         FOR x:=0 TO 10 DO
           BEGIN
             Byte:=Symbol.Pic[y*11+x];
             PlotByte(CHR(tlx+x),CHR(tly+y),Byte)
           END
END;

{======================================================}

PROCEDURE BuildMenu(VAR MenuNum,Choice:INTEGER;VAR ReDraw:BOOLEAN);

VAR
  Length,Count:INTEGER;
  PicName:MenuList;
  
BEGIN
  Length:=-1; {some out of range value}
  REPEAT
    IF Choice = Length THEN 
      BEGIN
        EraseMenu;
        Choice:=1;
        ReDraw:=TRUE;
      END;
    MenuNum:=(MenuNum+1) MOD 5;
    IF MenuNum = 4 THEN Length:=15 ELSE Length:=MaxMenuLen;
    FOR Count:=1 TO Length-1 DO
      PicName[Count]:=PicList[MenuNum*27+Count-1];
    PicName[Length]:='Next Menu       ';
    MenuChoice(0,0,MaxMenuWidth,Length,PicName,Choice,ReDraw);
  UNTIL Choice <> Length;
  ReDraw:=FALSE
END;

{======================================================}

PROCEDURE BrowseLib;

VAR
  x,y,MenuNum,Choice:INTEGER;
  ReDraw:BOOLEAN;

BEGIN
  x:=0;
  y:=0;
  MenuNum:=4;
  Choice:=1;
  ReDraw:=TRUE;
  REPEAT
    BuildMenu(MenuNum,Choice,ReDraw);
    IF Choice <> 0 THEN PlotPic(x+24,y+32,MenuNum*27+Choice-1);
    x:=((x+12) MOD 60);
    IF x = 0 THEN y:=(y+55) MOD 220;
    MenuNum:=MenuNum-1
  UNTIL Choice = 0;
END;  

{======================================================}

{Main Program}

BEGIN
  CLS;
  CursorOff;
  StatusOff;
  Initialise;
  LoadHex;
  GetMenu;
  GotoXY(36,5);
  Write('                           ');
  BrowseLib;
  CursorOn;
  StatusOn;
  CLS
END.
 ;
  GetMenu;
  GotoXY(36,5);
  Write('