ppm_write_gr15.bas

1 REM *****************************
2 REM Procedure to store content of
3 REM graphics memory in graphics
4 REM mode GR.15+16 (160x192x2bpp)
5 REM into standard PPM file.
6 REM *****************************
7 REM
8 REM
9 REM
10 DIM FILENAME$(20)
20 FILENAME$="H:TEST.PPM"
30 GRAPHICS 15+16
40 COLOR 1
50 PLOT 0,0:DRAWTO 159,191
54 COLOR 2
55 PLOT 159,96:DRAWTO 159,191
56 PLOT 112,191:DRAWTO 159,191
60 PLOT 159,96:DRAWTO 159,191
70 PLOT 112,191:DRAWTO 159,191
80 COLOR 3:CIRCLE 20,20,10
90 EXEC WRITE_PPM
999 STOP 
10000 ------------------------------
10010 REM Store video RAM
10020 REM in graphics mode #15 into
10030 REM PPM (Portable PixMap) file
10035 REM
10040 REM Filename is to be provided
10050 REM via FILENAME$ variable
10055 REM (Example: "H:TEST.PPM")
10060 ------------------------------
10070 PROC WRITE_PPM
10071   OPEN #1,8,0,FILENAME$
10072   REM PBM HEADER: BINARY FORMAT
10073   PRINT #1;"P6";
10074   PUT #1,13
10075   REM BITMAP RESOLUTION
10076   PRINT #1;"160 192";
10077   PUT #1,13
10078   REM MAXIMUM VALUE
10079   PRINT #1;"255";
10080   PUT #1,13
10130   REM WRITE VIDEO RAM TO FILE
10135   FOR Y=0 TO 191
10140     FOR X=0 TO 159 
10145       LOCATE X,Y,C
10150       GOTO C + 10160
10155       REM COLOR MAPPING
10160       PUT #1,0:PUT #1,0:PUT #1,0:GOTO 10180
10161       PUT #1,155:PUT #1,84:PUT #1,70:GOTO 10180
10162       PUT #1,116:PUT #1,165:PUT #1,47:GOTO 10180
10163       PUT #1,3:PUT #1,70:PUT #1,83:GOTO 10180
10180     NEXT X
10185   NEXT Y
10190   CLOSE #1
10200 ENDPROC