\    Convert GEM DRAW -> HP Laser printer file
\    to MicroSoft Paint format
\    C 1989 by Martin Tracy

52 CONSTANT #FCB   \ Size of fcb in bytes
-1 CONSTANT TRUE
-1 CONSTANT EOF#   \ Special end-of-file char
27 CONSTANT ESC#   \ ESCape char

\ Create a file control block (FCB)
: FILE   VARIABLE  #FCB CELL - ALLOT ;

FILE INPUT    \ GEM DRAW  .HPL file
FILE OUTPUT   \ MicroSoft .MSP file

VARIABLE BUF   \ line buffer for faster I/O
  1024 CELL - ALLOT

VARIABLE #BUF  \ number of bytes in buffer
VARIABLE PTR   \ line buffer pointer

\ Read one character, buffered.
: GETC ( - c)
   PTR @ #BUF @ =
   IF  BUF 1024 INPUT READ-FILE  DUP #BUF !
       IF  BUF C@  1 PTR !  ELSE  EOF#  THEN
   ELSE  BUF PTR @ + C@  1 PTR +!  THEN ;

VARIABLE OBUF   \ Output buffer

\ Write one character.
: PUTC ( c)
   OBUF C!  OBUF 1 OUTPUT WRITE-FILE DROP ;

\ Read numbers upto first non-convertable char.
\ Return converted number and char.
: GETCOOD ( - n c)
   0 ( sum)  0 DPL !
   BEGIN  GETC DUP EOF# = IF  EXIT  THEN   DUP [CHAR] . =
     IF  DROP  1 DPL !
     ELSE  DUP 10 DIGIT
       IF  NIP  SWAP 10 * +
       ELSE  DROP  DPL @ 0= IF  SWAP 10 * SWAP  THEN  EXIT  THEN
     THEN
   AGAIN ;

\ Read and convert cursor to horizontal and vertical coords.
: GETCOODS ( - h v 0 | EOF)
   BEGIN
     BEGIN  GETC  DUP EOF# = IF  EXIT  THEN   ESC# = UNTIL
         GETC [CHAR] & =  DUP
     IF  GETC [CHAR] a =  AND  THEN  DUP
     IF  DROP  GETCOOD [CHAR] h =
         IF    GETCOOD [CHAR] V - ABORT" Syntax"  TRUE
         ELSE  DROP 0  THEN
     THEN
   UNTIL  0 ;

\ Read number of rows of graphics output.
: GETROWS ( - n)
   GETC ESC# =
   IF  GETC [CHAR] * =
   IF  GETC [CHAR] r =
   IF  GETC [CHAR] 1 =
   IF  GETC [CHAR] A =
   IF  GETC ESC# =
   IF  GETC [CHAR] * =
   IF  GETC [CHAR] b =
   IF  0 BEGIN  GETC  DUP [CHAR] 0 [CHAR] 9 1+ WITHIN
         WHILE  SWAP 10 * SWAP [CHAR] 0 - +
         REPEAT [CHAR] W - ABORT" Syntax" ( count) EXIT
   THEN THEN THEN THEN THEN THEN THEN THEN  0 ;

: .## ( u)
   BASE @ HEX SWAP  0 <# # # #> TYPE SPACE  BASE ! ;

VARIABLE PIXELS
640 8 / 350 * CELL - ALLOT

VARIABLE MINROW
VARIABLE MINCOL
VARIABLE MAXROW
VARIABLE MAXCOL

: MAXCOODS ( h v r)
   >R  DUP MINROW @ < IF  DUP MINROW !  THEN
       DUP MAXROW @ > IF  DUP MAXROW !  THEN  DROP
       DUP MINCOL @ < IF  DUP MINCOL !  THEN  R> 192 * +
       DUP MAXCOL @ > IF  DUP MAXCOL !  THEN  DROP ;

: 3DUP   DUP 2OVER ROT ;

: SETCOODS ( h v r)
   >R  MINROW @ - 24 /  80 *  SWAP MINCOL @ - 192 / + ( off)
   PIXELS +  R> 0 DO  GETC OVER C@ OR OVER C!  1+ LOOP  DROP ;

: PASS1
   CR ." Pass 1"   0 PTR ! 0 #BUF !
   INPUT FCB>N INPUT FOPEN  0= ABORT" Can't open"
   0 DUP MAXROW ! MAXCOL !  32000 DUP MINROW ! MINCOL !
   BEGIN  GETCOODS  EOF# -
   WHILE  GETROWS ?DUP IF  MAXCOODS  ELSE  2DROP  THEN
   REPEAT
   INPUT CLOSE-FILE ;

: PASS2
   CR ." Pass 2"   0 PTR !  0 #BUF !
   INPUT FCB>N INPUT FOPEN  0= ABORT" Can't open"
   PIXELS [ 640 8 / 350 * ] LITERAL 0 FILL
   BEGIN  GETCOODS  EOF# -
   WHILE  GETROWS ?DUP IF  SETCOODS  ELSE  2DROP  THEN
   REPEAT
   INPUT CLOSE-FILE ;

VARIABLE #COLS
VARIABLE #ROWS

CREATE MSP_TABLE
   0 , 0 , 0 , 0 , 1 , 1 , 1 , 1 ,
   0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,

VARIABLE MSP_HEAD
  16 1- CELLS ALLOT

: MSP_HEADER
   MSP_TABLE MSP_HEAD 16 CELLS MOVE
   " DanM" MSP_HEAD SWAP MOVE
   #COLS @ 8 * MSP_HEAD 2DUP 2 CELLS + ! 8 CELLS + !
   #ROWS @     MSP_HEAD 2DUP 3 CELLS + ! 9 CELLS + !
   MSP_HEAD 16 CELLS OUTPUT WRITE-FILE DROP ;

: PASS3
   CR ." Pass 3"
   OUTPUT FCB>N OUTPUT FMAKE  0= ABORT" Can't make"
   MAXROW @ MINROW @ -  24 / 1+ #ROWS !
   MAXCOL @ MINCOL @ - 192 /    #COLS !
   MSP_HEADER  PIXELS
   #ROWS @ 0 DO
   #COLS @ 0 DO  DUP I + C@ PUTC  LOOP  80 +  LOOP  DROP
   OUTPUT CLOSE-FILE
   CR ." Width in inches: " #COLS @ 800 300 */
   0 <# # # [CHAR] . HOLD #S #> TYPE SPACE ;

: GEM2MSP
   INPUT #FCB 0 FILL  OUTPUT #FCB 0 FILL
   CR ." Input  File: " INPUT  CELL+ 50 EXPECT
                      0 INPUT  CELL+ SPAN @ + C!
   CR ." Output File: " OUTPUT CELL+ 50 EXPECT
                      0 OUTPUT CELL+ SPAN @ + C!
   PASS1  PASS2  PASS3 ;