home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / ZEN1_10.ZIP / GEM2MSP.SRC < prev    next >
Encoding:
Text File  |  1989-09-01  |  4.2 KB  |  150 lines
  1. \    Convert GEM DRAW -> HP Laser printer file
  2. \    to MicroSoft Paint format
  3. \    C 1989 by Martin Tracy
  4.  
  5. 52 CONSTANT #FCB   \ Size of fcb in bytes
  6. -1 CONSTANT TRUE
  7. -1 CONSTANT EOF#   \ Special end-of-file char
  8. 27 CONSTANT ESC#   \ ESCape char
  9.  
  10. \ Create a file control block (FCB)
  11. : FILE   VARIABLE  #FCB CELL - ALLOT ;
  12.  
  13. FILE INPUT    \ GEM DRAW  .HPL file
  14. FILE OUTPUT   \ MicroSoft .MSP file
  15.  
  16. VARIABLE BUF   \ line buffer for faster I/O
  17.   1024 CELL - ALLOT
  18.  
  19. VARIABLE #BUF  \ number of bytes in buffer
  20. VARIABLE PTR   \ line buffer pointer
  21.  
  22. \ Read one character, buffered.
  23. : GETC ( - c)
  24.    PTR @ #BUF @ =
  25.    IF  BUF 1024 INPUT READ-FILE  DUP #BUF !
  26.        IF  BUF C@  1 PTR !  ELSE  EOF#  THEN
  27.    ELSE  BUF PTR @ + C@  1 PTR +!  THEN ;
  28.  
  29. VARIABLE OBUF   \ Output buffer
  30.  
  31. \ Write one character.
  32. : PUTC ( c)
  33.    OBUF C!  OBUF 1 OUTPUT WRITE-FILE DROP ;
  34.  
  35. \ Read numbers upto first non-convertable char.
  36. \ Return converted number and char.
  37. : GETCOOD ( - n c)
  38.    0 ( sum)  0 DPL !
  39.    BEGIN  GETC DUP EOF# = IF  EXIT  THEN   DUP [CHAR] . =
  40.      IF  DROP  1 DPL !
  41.      ELSE  DUP 10 DIGIT
  42.        IF  NIP  SWAP 10 * +
  43.        ELSE  DROP  DPL @ 0= IF  SWAP 10 * SWAP  THEN  EXIT  THEN
  44.      THEN
  45.    AGAIN ;
  46.  
  47. \ Read and convert cursor to horizontal and vertical coords.
  48. : GETCOODS ( - h v 0 | EOF)
  49.    BEGIN
  50.      BEGIN  GETC  DUP EOF# = IF  EXIT  THEN   ESC# = UNTIL
  51.          GETC [CHAR] & =  DUP
  52.      IF  GETC [CHAR] a =  AND  THEN  DUP
  53.      IF  DROP  GETCOOD [CHAR] h =
  54.          IF    GETCOOD [CHAR] V - ABORT" Syntax"  TRUE
  55.          ELSE  DROP 0  THEN
  56.      THEN
  57.    UNTIL  0 ;
  58.  
  59. \ Read number of rows of graphics output.
  60. : GETROWS ( - n)
  61.    GETC ESC# =
  62.    IF  GETC [CHAR] * =
  63.    IF  GETC [CHAR] r =
  64.    IF  GETC [CHAR] 1 =
  65.    IF  GETC [CHAR] A =
  66.    IF  GETC ESC# =
  67.    IF  GETC [CHAR] * =
  68.    IF  GETC [CHAR] b =
  69.    IF  0 BEGIN  GETC  DUP [CHAR] 0 [CHAR] 9 1+ WITHIN
  70.          WHILE  SWAP 10 * SWAP [CHAR] 0 - +
  71.          REPEAT [CHAR] W - ABORT" Syntax" ( count) EXIT
  72.    THEN THEN THEN THEN THEN THEN THEN THEN  0 ;
  73.  
  74. : .## ( u)
  75.    BASE @ HEX SWAP  0 <# # # #> TYPE SPACE  BASE ! ;
  76.  
  77. VARIABLE PIXELS
  78. 640 8 / 350 * CELL - ALLOT
  79.  
  80. VARIABLE MINROW
  81. VARIABLE MINCOL
  82. VARIABLE MAXROW
  83. VARIABLE MAXCOL
  84.  
  85. : MAXCOODS ( h v r)
  86.    >R  DUP MINROW @ < IF  DUP MINROW !  THEN
  87.        DUP MAXROW @ > IF  DUP MAXROW !  THEN  DROP
  88.        DUP MINCOL @ < IF  DUP MINCOL !  THEN  R> 192 * +
  89.        DUP MAXCOL @ > IF  DUP MAXCOL !  THEN  DROP ;
  90.  
  91. : 3DUP   DUP 2OVER ROT ;
  92.  
  93. : SETCOODS ( h v r)
  94.    >R  MINROW @ - 24 /  80 *  SWAP MINCOL @ - 192 / + ( off)
  95.    PIXELS +  R> 0 DO  GETC OVER C@ OR OVER C!  1+ LOOP  DROP ;
  96.  
  97. : PASS1
  98.    CR ." Pass 1"   0 PTR ! 0 #BUF !
  99.    INPUT FCB>N INPUT FOPEN  0= ABORT" Can't open"
  100.    0 DUP MAXROW ! MAXCOL !  32000 DUP MINROW ! MINCOL !
  101.    BEGIN  GETCOODS  EOF# -
  102.    WHILE  GETROWS ?DUP IF  MAXCOODS  ELSE  2DROP  THEN
  103.    REPEAT
  104.    INPUT CLOSE-FILE ;
  105.  
  106. : PASS2
  107.    CR ." Pass 2"   0 PTR !  0 #BUF !
  108.    INPUT FCB>N INPUT FOPEN  0= ABORT" Can't open"
  109.    PIXELS [ 640 8 / 350 * ] LITERAL 0 FILL
  110.    BEGIN  GETCOODS  EOF# -
  111.    WHILE  GETROWS ?DUP IF  SETCOODS  ELSE  2DROP  THEN
  112.    REPEAT
  113.    INPUT CLOSE-FILE ;
  114.  
  115. VARIABLE #COLS
  116. VARIABLE #ROWS
  117.  
  118. CREATE MSP_TABLE
  119.    0 , 0 , 0 , 0 , 1 , 1 , 1 , 1 ,
  120.    0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,
  121.  
  122. VARIABLE MSP_HEAD
  123.   16 1- CELLS ALLOT
  124.  
  125. : MSP_HEADER
  126.    MSP_TABLE MSP_HEAD 16 CELLS MOVE
  127.    " DanM" MSP_HEAD SWAP MOVE
  128.    #COLS @ 8 * MSP_HEAD 2DUP 2 CELLS + ! 8 CELLS + !
  129.    #ROWS @     MSP_HEAD 2DUP 3 CELLS + ! 9 CELLS + !
  130.    MSP_HEAD 16 CELLS OUTPUT WRITE-FILE DROP ;
  131.  
  132. : PASS3
  133.    CR ." Pass 3"
  134.    OUTPUT FCB>N OUTPUT FMAKE  0= ABORT" Can't make"
  135.    MAXROW @ MINROW @ -  24 / 1+ #ROWS !
  136.    MAXCOL @ MINCOL @ - 192 /    #COLS !
  137.    MSP_HEADER  PIXELS
  138.    #ROWS @ 0 DO
  139.    #COLS @ 0 DO  DUP I + C@ PUTC  LOOP  80 +  LOOP  DROP
  140.    OUTPUT CLOSE-FILE
  141.    CR ." Width in inches: " #COLS @ 800 300 */
  142.    0 <# # # [CHAR] . HOLD #S #> TYPE SPACE ;
  143.  
  144. : GEM2MSP
  145.    INPUT #FCB 0 FILL  OUTPUT #FCB 0 FILL
  146.    CR ." Input  File: " INPUT  CELL+ 50 EXPECT
  147.                       0 INPUT  CELL+ SPAN @ + C!
  148.    CR ." Output File: " OUTPUT CELL+ 50 EXPECT
  149.                       0 OUTPUT CELL+ SPAN @ + C!
  150.    PASS1  PASS2  PASS3 ;