home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / qbnewsl / qbnws202 / asciiart / asciiart.bas next >
BASIC Source File  |  1991-05-08  |  34KB  |  550 lines
  1. 'ASCIIART.BAS  Copyright 1991 by
  2. 'Charles Graham, POB 58634, St. Louis, MO 63158
  3. 'All rights reserved
  4.  
  5. 'FUNCTION dir$, by David Cleary, has been
  6. 'modified for use in this program.
  7.  
  8. 'ASCIIART.BAS displays ASCII (text) files as
  9. 'color images on EGA or color CGA systems.
  10.  
  11. 'To execute properly, QuickBASIC must be
  12. 'invoked with the /l option:  i.e., QB/L.
  13.  
  14. '$INCLUDE: 'qb.bi'                               'Include the QB help
  15.                                                  '  file for interrupts
  16. DEFINT A-Z                                       'Variables are type INTEGER
  17.                                                  '  unless otherwised declared
  18. DECLARE SUB capturecodes (printercode$)          'Get printer codes
  19. DECLARE SUB checkprinter ()                      'Is printer available?
  20. DECLARE SUB clearbox ()                          'Clear monitor window
  21. DECLARE FUNCTION dir$ (filespec$)                'Finds *.ASC files
  22.                                                  'The next SUB draws a window
  23. DECLARE SUB frame (upperrow, leftcolumn, lowerrow, rightcolumn, foreground)
  24. DECLARE SUB getmonitor (monitortype$)            'Is it EGA or CGA?
  25. DECLARE SUB getprinter (printertype$)            'What kind of printer?
  26. DECLARE SUB heading ()                           'Print heading
  27. DECLARE SUB loadarray (monitortype$)             'Set color attributes
  28. DECLARE SUB printnames ()                        'Print file names
  29. DECLARE SUB printpicture (n$)                    'Print picture
  30. DECLARE SUB viewpicture (monitortype$, n$, scrn) 'View picture
  31.  
  32. ON ERROR GOTO enditall                           'Just in case
  33.  
  34. DIM SHARED forecolor(255)                        'Dimension array
  35. DIM SHARED inreg AS regtype, outreg AS regtype   'Define inreg and outreg
  36.                                                  'as regtype
  37.  
  38. DIM SHARED dos                                   'Used with FUNCTION dir$
  39. DIM SHARED dta AS STRING * 44                    'Used with FUNCTION dir$
  40. DIM SHARED findfirst                             'Used with FUNCTION dir$
  41. DIM SHARED findnext                              'Used with FUNCTION dir$
  42. DIM SHARED null$                                 'Used with FUNCTION dir$
  43. DIM SHARED regs AS regtypex                      'Used with FUNCTION dir$
  44. DIM SHARED setdta                                'Used with FUNCTION dir$
  45. dos = &H21                                       'Used with FUNCTION dir$
  46. findfirst = &H4E00                               'Used with FUNCTION dir$
  47. findnext = &H4F00                                'Used with FUNCTION dir$
  48. null$ = CHR$(0)                                  'Used with FUNCTION dir$
  49. setdta = &H1A00                                  'Used with FUNCTION dir$
  50.  
  51. COLOR 7, 0                                       'White on black
  52. CLS                                              'Clear screen
  53. CALL getmonitor(monitortype$)                    'Is it EGA or CGA?
  54. CALL loadarray(monitortype$)                     'Set color attributes
  55. CALL getprinter(printertype$)                    'What kind of printer?
  56. CALL printnames                                  'Print file names
  57. DO WHILE n$ <> "DIANE" AND n$ <> "FRANCES" AND n$ <> "OTHER"
  58.     n$ = ""                                      'Initialize file name to null
  59.     IF scrn <> 0 THEN                            'SCREEN mode not 0?
  60.         CLS                                      '  Clear screen
  61.         IF monitortype$ = "C" THEN               '  CGA?
  62.             WIDTH 80, 25                         '    Invoke 80x25 text mode
  63.         END IF                                   '
  64.         SCREEN 0                                 '  Invoke SCREEN mode 0
  65.         scrn = 0                                 '  Set indicator to 0
  66.         CALL frame(4, 12, 21, 66, 13)            '  Draw a window
  67.         CALL heading                             '  Print heading
  68.         CALL printnames                          '  Print file names
  69.     ELSE                                         'SCREEN mode is 0
  70.         LOCATE 19, 13, 0                         '  Position cursor
  71.         PRINT SPACE$(52);                        '  Clear line
  72.     END IF                                       '
  73.     COLOR 15                                     'Bright white
  74.     LOCATE 19, 27, 1                             'Position cursor
  75.     PRINT "Name of picture? ";                   'Ask user for file name
  76.     COLOR 13                                     'Bright magenta
  77.     LINE INPUT ; ""; n$                          'Null prompt
  78.     IF n$ = "" THEN                              'File name null?
  79.         EXIT DO                                  '  T-T-That's all folks
  80.     ELSE                                         'File name not null
  81.         n$ = UCASE$(n$)                          '  Convert name to upper case
  82.     END IF                                       '
  83.     IF n$ = "DIANE" OR n$ = "FRANCES" OR n$ = "OTHER" THEN
  84.         CLOSE                                    'CLOSE any open files
  85.         OPEN n$ + ".ASC" FOR INPUT AS 1          'OPEN selected file
  86.         IF printertype$ <> "N" THEN              'Printer selected?
  87.             LOCATE 19, 13, 0                     '  Position cursor
  88.             PRINT SPACE$(52);                    '  Clear line
  89.             LOCATE 19, 29, 1                     '  Position cursor
  90.             COLOR 15                             '  Bright white
  91.             PRINT "Print or View [P/V]? ";       '  Print it or display it?
  92.             selection$ = ""                      '  Initialize to null
  93.             WHILE selection$ <> "P" AND selection$ <> "V" 'Wait for P or V
  94.                 selection$ = UCASE$(INKEY$)      '    Make it upper case
  95.             WEND                                 '  Got it
  96.             PRINT selection$;                    '  Show user
  97.             IF selection$ = "P" THEN             '  Print it?
  98.                 CALL printpicture(n$)            '    Print picture
  99.             ELSE                                 '  View it?
  100.                 CALL viewpicture(monitortype$, n$, scrn)'View picture
  101.             END IF                               '
  102.         ELSE                                     'No printer selected
  103.             CALL viewpicture(monitortype$, n$, scrn)'View picture
  104.         END IF                                   '
  105.     END IF                                       '
  106.     n$ = ""                                      'Initialize file name to null
  107. LOOP                                             '
  108.  
  109. enditall:                                        'Just in case
  110. IF scrn <> 0 THEN                                'SCREEN mode not 0?
  111.     SCREEN 0                                     '  Set SCREEN mode to 0
  112.     COLOR 7, 0                                   '  White on black
  113.     CLS                                          '  Clear screen
  114. ELSE                                             'SCREEN mode 0
  115.     LOCATE 19, 13, 0                             '  Position cursor
  116.     PRINT SPACE$(52);                            '  Clear line
  117. END IF                                           '
  118. COLOR 31, 0                                      'Blink bright white on black
  119. SELECT CASE ERR                                  'Any errors?
  120.     CASE 0                                       '  No?
  121.         SELECT CASE printertype$                 '    What type of printer?
  122.             CASE "C"                             '      Custom?
  123.                 printercode$ = ""                '        Initialize to null
  124.                 CALL clearbox                    '        Clear monitor window
  125.                 LOCATE 12, 21, 0                 '        Position cursor
  126.                 COLOR 14                         '        Bright yellow
  127.                 PRINT "Enter the numeric ASCII value of each"
  128.                 LOCATE 13, 20                    '        Position cursor
  129.                 PRINT "character you want sent to your printer."
  130.                 LOCATE 14, 22                    '        Position cursor
  131.                 PRINT "Press the RETURN key after each one."
  132.                 LOCATE 16, 27                    '        Position cursor
  133.                 PRINT "To quit sending characters"
  134.                 LOCATE 17, 23                    '        Position cursor
  135.                 PRINT "enter Q and press the RETURN key."'
  136.                 LOCATE 19, 26, 1                 '        Position cursor
  137.                 COLOR 15                         '        Bright white
  138.                 PRINT "Enter numeric ASCII value:  ";
  139.                 CALL capturecodes(printercode$)  '        Get printer codes
  140.                 LPRINT printercode$;             '        Send control codes
  141.                 LOCATE 19, 13                    '        Position cursor
  142.                 PRINT SPACE$(52);                '        Clear the line
  143.                 COLOR 31, 0                     _
  144. '        Blink bright white on black
  145.             CASE "D"                             '      Datasouth 220?
  146.                 LPRINT CHR$(27) + "[" + "1" + "z"; '      Begin 6 LPI
  147.                 LPRINT CHR$(27) + "U" + "0";    _
  148. '        Bi-directional printing
  149.                 LPRINT CHR$(27) + "$" + "1" + "0" + "M"; '10 CPI, draft mode
  150.             CASE "I"                             '      IBM Proprinter?
  151.                 LPRINT CHR$(27) + "A" + CHR$(12); '       Store 6 LPI
  152.                 LPRINT CHR$(27) + "2";           '        Begin stored LPI
  153.                 LPRINT CHR$(27) + "U" + CHR$(0);_
  154. '        Cancel uni-directional
  155.                 LPRINT CHR$(27) + "H";           '        Cancel NLQ mode
  156.                 LPRINT CHR$(18);                _
  157. '        Cancel condensed mode
  158.         END SELECT                               '
  159.         LOCATE 19, 37                            '      Position cursor
  160.         PRINT "Bye!";                            '      Bid user farewell
  161.     CASE 24, 25                                  '  Printer problem?
  162.         LOCATE 19, 29                            '    Position cursor
  163.         PRINT "Check printer status!";           '    Have user check printer
  164.     CASE ELSE                                    '  Other problem?
  165.         LOCATE 19, 28                            '    Position cursor
  166.         PRINT "Error type"; ERR; "occurred!";    '    Tell user the problem
  167. END SELECT                                       '
  168. COLOR 7, 0                                       'White on black
  169. WIDTH "lpt1:", 80                                'Reset printer width
  170. WIDTH 80, 25                                     'Restore 80x25 text mode
  171. LOCATE 23, 1, 1                                  'Position cursor
  172. CLOSE                                            'Close any open files
  173. END                                              'T-T-That's all folks!
  174.  
  175. 'The following DATA are ASCII codes for various characters.
  176. 'The codes are read in SUB loadarray where color attributes
  177. 'are set.  If a user specifies an EGA system all six lines
  178. 'of DATA are significant.  For CGA systems, only the first
  179. 'three lines are significant.  Characters in insignificant
  180. 'lines and characters not referenced at all default to black
  181. 'except character 32 (a space or blank) which defaults to
  182. 'bright white on EGA systems and white on CGA systems.
  183.  
  184. 'Users that want to experiment with ASCIIART.BAS can alter
  185. 'the DATA below and SUB loadarray to alter the colors
  186. 'associated with various characters.  As originally published,
  187. 'the color attributes associated with each line are as follows.
  188.  
  189. '     EGA color          CGA color
  190.  
  191. '      7 white           3 white
  192. DATA 33, 34, 39, 44, 45, 46, 94, 95, 96
  193.  
  194. '     14 bright yellow   1 cyan
  195. DATA 40, 41, 43, 47, 58, 60, 62, 63, 92
  196.  
  197. '     12 bright red      2 magenta
  198. DATA 49, 55, 59, 61, 73, 76, 84, 89, 91, 93
  199.  
  200. '      8 grey            0 black
  201. DATA 37, 42, 48, 52, 54, 57, 67, 70, 74, 75, 80, 86, 88, 90
  202.  
  203. '      6 brown           0 black
  204. DATA 36, 38, 50, 51, 53, 64, 65, 68, 69, 72, 79, 82, 83, 85
  205.  
  206. '      8 grey            0 black
  207. DATA 35, 56, 66, 71, 77, 78, 81, 87
  208.  
  209. SUB capturecodes (printercode$)                  'Get printer codes
  210. DO                                               '
  211.     LOCATE 19, 54                                'Position cursor
  212.     PRINT "   "                                  'Clear the area
  213.     LOCATE 19, 54                                'Position cursor
  214.     asciicode$ = ""                              'Initialize acode to null
  215.     DO                                           '
  216.         character$ = ""                          '  Initialize char to null
  217.         DO                                       '    Wait for digit, "Q",
  218.             character$ = UCASE$(INKEY$)          '    backspace or return
  219.         LOOP UNTIL (character$ >= "0" AND character$ <= "9") OR _
  220. character$ = "Q" OR character$ = CHR$(8) OR character$ = CHR$(13)
  221.         SELECT CASE character$                   '  See what we got
  222.             CASE "0" TO "9"                      '    Digit?
  223.                 IF LEN(asciicode$) <= 2 THEN     '      If valid, add it to
  224.                     IF VAL(asciicode$ + character$) <= 255 THEN ' asciicode
  225.                         asciicode$ = asciicode$ + character$    ' and
  226.                         PRINT character$;        '        print it
  227.                     END IF                       '
  228.                 END IF                           '
  229.             CASE "Q"                             '    "Q"?
  230.                 IF LEN(asciicode$) = 0 THEN      '      If asciicode null
  231.                     asciicode$ = character$      '        make asciicode "Q"
  232.                     PRINT character$;            '        and print it
  233.                 END IF                           '
  234.             CASE CHR$(13)                        '    Return?
  235.                 IF asciicode$ = "Q" THEN         '      If asciicode is "Q"
  236.                     EXIT SUB                     '        we're outtahere
  237.                 ELSE                             '      If not "Q" but is
  238.                                                  '        is valid, add it to
  239.                                                  '        printercode
  240.                     IF LEN(asciicode$) AND VAL(asciicode$) <= 255 THEN
  241.                         printercode$ = printercode$ + CHR$(VAL(asciicode$))
  242.                     END IF                       '
  243.                 END IF                           '
  244.             CASE CHR$(8)                         '    Backspace?
  245.                 LOCATE 19, 54                    '      Position cursor
  246.                 PRINT "   ";                     '      Clear the area
  247.                 LOCATE 19, 54                    '      Position cursor
  248.                 IF LEN(asciicode$) <= 1 THEN     '      If asciicode 1 char,
  249.                     asciicode$ = ""              '        make it null
  250.                 ELSE                             '      If longer, shorten it
  251.                     asciicode$ = LEFT$(asciicode$, LEN(asciicode$) - 1) 'by
  252.                     PRINT asciicode$;            '        1 char and print it
  253.                 END IF                           '
  254.         END SELECT                               '
  255.     LOOP UNTIL character$ = CHR$(13)             '  End loop on return key
  256. LOOP                                             '
  257. END SUB                                          '
  258.  
  259. SUB checkprinter                                 'Is printer available?
  260. inreg.ax = &H200                                 'Set AH = 2; AL = 0
  261. CALL interrupt(&H17, inreg, outreg)              'Call DOS interrupt &H17 (23)
  262. p = outreg.ax                                    'Capture AX
  263. IF ((ABS(p / 256) AND 8) = 0) THEN               'Printer on?
  264.     IF ((ABS(p / 256) AND 64) = 64) THEN         '  Printer on line?
  265.         EXIT SUB                                 '    We're OK; let's go
  266.     END IF                                       '
  267. END IF                                           '
  268. ERROR 24                                         'Simulate error
  269. END SUB                                          '
  270.  
  271. SUB clearbox                                     'Clear monitor window
  272. FOR x = 11 TO 20                                 'Work on lines 11 through 20
  273.     LOCATE x, 13, 0                              '  Position cursor
  274.     PRINT SPACE$(52);                            '  Clear the area
  275. NEXT x                                           '
  276. END SUB                                          '
  277.  
  278. FUNCTION dir$ (filespec$) STATIC                 'Finds *.ASC files
  279. regs.ax = setdta                                 'Set DTA function
  280. regs.dx = VARPTR(dta)                            'DS:DX points to our DTA
  281. regs.ds = -1                                     'Use current value for DS
  282. interruptx dos, regs, regs                       'Do the interrupt
  283. IF LEN(filespec$) THEN                           'Filespec$ isn't null?
  284.                                                  '  Find first matching file
  285.     filespecz$ = filespec$ + null$               '  Make filespec$ into an
  286.                                                  '    ASCIIZ string
  287.     regs.ax = findfirst                          '  Perform a FindFirst
  288.     regs.cX = 0                                  '  Only look for normal files
  289.     regs.dx = SADD(filespecz$)                  _
  290. '  DS:DX points to ASCIIZ file
  291.     regs.ds = -1                                 '  Use current DS
  292. ELSE                                             'Filespec$ is null?
  293.     regs.ax = findnext                           '  Find next matching file
  294. END IF                                           '
  295. interruptx dos, regs, regs                       'Do the interrupt
  296. IF regs.flags AND 1 THEN                         'No files found?
  297.     dir$ = ""                                    '  Return null string
  298. ELSE                                             'Found one?
  299.     null = INSTR(31, dta, null$)                 '  Get the filename found
  300.     dir$ = MID$(dta, 31, null - 30)              '  It's an ASCIIZ string
  301. END IF                                           '    starting at offset 30
  302. END FUNCTION                                     '    of the DTA
  303.  
  304. SUB frame (upperrow, leftcolumn, lowerrow, rightcolumn, foreground)
  305.                                                  'This SUB draws a window
  306. COLOR foreground                                 'Set color of window frame
  307. LOCATE upperrow, leftcolumn, 0                   'Position cursor
  308.                                                  'Next line prints top line
  309. PRINT CHR$(201) + STRING$(rightcolumn - leftcolumn - 2, 205) + CHR$(187);
  310. FOR ct = upperrow + 1 TO lowerrow - 1            'Print sides of frame
  311.     LOCATE ct, leftcolumn                        '  Position cursor
  312.                                                  '  Next line prints sides
  313.     PRINT CHR$(186) + SPACE$(rightcolumn - leftcolumn - 2) + CHR$(186);
  314. NEXT ct                                          '
  315. LOCATE lowerrow, leftcolumn                      'Position cursor
  316.                                                  'Next line print bottom line
  317. PRINT CHR$(200) + STRING$(rightcolumn - leftcolumn - 2, 205) + CHR$(188);
  318. END SUB
  319.  
  320. SUB getmonitor (monitortype$)                    'Is it EGA or CGA?
  321. CALL frame(4, 12, 21, 66, 13)                    'Draw a window
  322. CALL heading                                     'Print heading
  323. LOCATE 14, 36                                    'Position cursor
  324. COLOR 11                                         'Bright cyan
  325. PRINT "Enter";                                   '
  326. LOCATE 15, 30                                    'Position cursor
  327. COLOR 15                                         'Bright white
  328. PRINT "C ";                                      '
  329. COLOR 14                                         'Bright yellow
  330. PRINT "for a ";                                  '
  331. COLOR 15                                         'Bright white
  332. PRINT "CGA ";                                    '
  333. COLOR 14                                         'Bright yellow
  334. PRINT "system";                                  '
  335. COLOR 11                                         'Bright cyan
  336. LOCATE 16, 37                                    'Position cursor
  337. PRINT "or";                                      '
  338. LOCATE 17, 29                                    'Position cursor
  339. COLOR 15                                         '
  340. PRINT "E ";                                      '
  341. COLOR 14                                         'Bright yellow
  342. PRINT "for an ";                                 '
  343. COLOR 15                                         'Bright white
  344. PRINT "EGA ";                                    '
  345. COLOR 14                                         'Bright yellow
  346. PRINT "system.";                                 '
  347. LOCATE 19, 29, 1                                 'Position cursor
  348. COLOR 15                                         '
  349. PRINT "Your choice [C/E]? ";                     'Ask user
  350. WHILE monitortype$ <> "C" AND monitortype$ <> "E"'Wait for "C" or "E"
  351.     monitortype$ = UCASE$(INKEY$)                '  change to upper case
  352. WEND                                             '
  353. PRINT monitortype$;                              'Tell user
  354. END SUB                                          '
  355.  
  356. SUB getprinter (printertype$)                    'What kind of printer?
  357. CALL clearbox                                    'Clear monitor window
  358. LOCATE 15, 28, 0                                 'Position cursor
  359. COLOR 15                                         'Bright white
  360. PRINT "Select printer option:"                   '
  361. LOCATE 16, 30                                    'Position cursor
  362. COLOR 14                                         'Bright yellow
  363. PRINT "IBM";                                     '
  364. LOCATE 16, 42                                    'Position cursor
  365. PRINT "Custom"                                   '
  366. LOCATE 17, 29                                    'Position cursor
  367. PRINT "DS220";                                   '
  368. LOCATE 17, 43                                    'Position cursor
  369. PRINT "None"                                     '
  370. COLOR 15                                         'Bright white
  371. LOCATE 19, 27, 1                                 'Position curwor
  372. PRINT "Your choice [C/D/I/N]? ";                 'Ask user
  373. printertype$ = ""                                'Initialize to null
  374.                                                  'Wait for C, D, I or N
  375. WHILE printertype$ <> "C" AND printertype$ <> "D" AND _
  376. printertype$ <> "I" AND printertype$ <> "N"
  377.     printertype$ = UCASE$(INKEY$)                '  Convert to upper case
  378. WEND                                             '
  379. PRINT printertype$;                              'Tell user
  380. SELECT CASE printertype$                         'Whadda we got?
  381.     CASE "I"                                     '  IBM Proprinter?
  382.         pc$ = CHR$(15)                           '    Condensed mode
  383.         pc$ = pc$ + CHR$(27) + "G"               '    Near Letter Quality mode
  384.         pc$ = pc$ + CHR$(27) + "U" + "1"         '    Uni-directional printing
  385.         pc$ = pc$ + CHR$(27) + "A" + CHR$(7)     '    7/72nds" line spacing
  386.         pc$ = pc$ + CHR$(27) + "2"               '    Begin line spacing
  387.         printercode$ = pc$                       '
  388.         CALL checkprinter                        '    Printer available?
  389.         LPRINT printercode$;                     '    Send control codes
  390.     CASE "D"                                     '  Datasouth 220?
  391.         pc$ = CHR$(27) + "$" + "1" + "1" + "M"   '    Begin 16 CPI spacing
  392.         pc$ = pc$ + CHR$(27) + "U" + "1"         '    Uni-directional printing
  393.         pc$ = pc$ + CHR$(27) + "A" + CHR$(7)     '    7/7nds" line spacing
  394.         printercode$ = pc$                       '
  395.         CALL checkprinter                        '    Printer available?
  396.         LPRINT printercode$;                     '    Send control codes
  397.     CASE "C"                                     '  User wants to customize?
  398.         printercode$ = ""                        '    Initialize to null
  399.         CALL clearbox                            '    Clear monitor window
  400.         LOCATE 12, 21, 0                         '    Position cursor
  401.         COLOR 14                                 '    Bright yellow
  402.         PRINT "Enter the numeric ASCII value of each"'Tell user what to do
  403.         LOCATE 13, 20                            '    Position cursor
  404.         PRINT "character you want sent to your printer."
  405.         LOCATE 14, 22                            '    Position cursor
  406.         PRINT "Press the RETURN key after each one." '
  407.         LOCATE 16, 27                            '    Position cursor
  408.         PRINT "To quit sending characters"       '
  409.         LOCATE 17, 23                            '    Position cursor
  410.         PRINT "enter Q and press the RETURN key."'
  411.         LOCATE 19, 26, 1                         '    Position cursor
  412.         COLOR 15                                 '    Bright white
  413.         PRINT "Enter numeric ASCII value:  ";    '
  414.         CALL capturecodes(printercode$)          '    Get printer codes
  415.         CALL checkprinter                        '    Printer available?
  416.         LPRINT printercode$;                     '    Send control codes
  417. END SELECT                                       '
  418. WIDTH "lpt1:", 255                               '    Disable line folding
  419. END SUB                                          '
  420.  
  421. SUB heading                                      'Print heading
  422. COLOR 12                                         'Bright red
  423. LOCATE 6, 35                                     'Position cursor
  424. PRINT "ASCIIART"                                 '
  425. COLOR 11                                         'Bright cyan
  426. LOCATE 8, 23                                     'Position cursor
  427. PRINT "Copyright 1991 by Charles Graham"         '
  428. LOCATE 9, 24                                     'Position cursor
  429. PRINT "POB 58634, St. Louis, MO 63158"           '
  430. LOCATE 10, 29                                    'Position cursor
  431. PRINT "All rights reserved"                      '
  432. END SUB                                          '
  433.  
  434. SUB loadarray (monitortype$)                     'Set color attributes
  435. FOR y = 1 TO 9                                   'Read 9 ASCII values
  436.      READ x                                      '
  437.      IF monitortype$ = "E" THEN                  '  EGA?
  438.         forecolor(x) = 7                         '    Store white
  439.      ELSE                                        '  CGA?
  440.         forecolor(x) = 3                         '    Store white
  441.      END IF                                      '
  442. NEXT y                                           '
  443. FOR y = 1 TO 9                                   'Read 9 ASCII values
  444.      READ x                                      '
  445.      IF monitortype$ = "E" THEN                  '  EGA?
  446.         forecolor(x) = 14                        '    Store bright yellow
  447.      ELSE                                        '  CGA?
  448.         forecolor(x) = 1                         '    Store cyan
  449.      END IF                                      '
  450. NEXT y                                           '
  451. FOR y = 1 TO 10                                  'Read 10 ASCII values
  452.      READ x                                      '
  453.      IF monitortype$ = "E" THEN                  '  EGA?
  454.         forecolor(x) = 12                        '    Store bright red
  455.      ELSE                                        '  CGA?
  456.         forecolor(x) = 2                         '    Store magenta
  457.      END IF                                      '
  458. NEXT y                                           '
  459. FOR y = 1 TO 14                                  'Read 14 ASCII values
  460.      READ x                                      '
  461.      IF monitortype$ = "E" THEN                  '  EGA?
  462.         forecolor(x) = 8                         '    Store grey
  463.      END IF                                      '
  464. NEXT y                                           '
  465. FOR y = 1 TO 14                                  'Read 14 ASCII values
  466.      READ x                                      '
  467.      IF monitortype$ = "E" THEN                  '  EGA?
  468.         forecolor(x) = 6                         '    Store brown
  469.      END IF                                      '
  470. NEXT y                                           '
  471. FOR y = 1 TO 8                                   'Read 8 ASCII values
  472.      READ x                                      '
  473.      IF monitortype$ = "E" THEN                  '  EGA?
  474.         forecolor(x) = 8                         '    Store grey
  475.      END IF                                      '
  476. NEXT y                                           '
  477. IF monitortype$ = "E" THEN                       'EGA?
  478.     forecolor(32) = 15                           '  Store bright white
  479. ELSE                                             'CGA?
  480.     forecolor(32) = 3                            '  Store white
  481. END IF                                           '
  482. END SUB                                          '
  483.  
  484. SUB printnames                                   'Print file names
  485. CALL clearbox                                    'Clear monitor window
  486. COLOR 14                                         'Bright yellow
  487. LOCATE 13, 17, 0                                 'Position cursor
  488. PRINT "To end, press RETURN key without picture name"; 'Tell user
  489. COLOR 13                                         'Light magenta
  490. LOCATE 15, 29                                    'Position cursor
  491. filespec$ = "*.asc"                              'Set find argument to *.asc
  492. found$ = dir$(filespec$)                         'Find matching file names
  493. WHILE LEN(found$)                                'While there are any left
  494.     picture$ = LEFT$(found$, INSTR(found$, ".") - 1) 'Format and PRINT name
  495.     PRINT LEFT$(picture$, 1) + LCASE$(MID$(picture$, 2, LEN(picture$) - 1)),
  496.     found$ = dir$("")                            '  Reinitialize found$
  497. WEND                                             '
  498. END SUB                                          '
  499.  
  500. SUB printpicture (n$)                            'Print picture
  501. LOCATE 19, 13, 0                                 'Position cursor
  502. PRINT SPACE$(52);                                'Clear the area
  503. n$ = LEFT$(n$, 1) + LCASE$(RIGHT$(n$, LEN(n$) - 1))'Format file name
  504. LOCATE 19, INT((78 - LEN("Printing " + n$)) / 2), 1'Position cursor
  505. PRINT "Printing " + n$;                          'Tell user
  506. a$ = ""                                          'Initialize to null
  507. a$ = INKEY$                                      'Grab keystroke, if any
  508. WHILE (NOT EOF(1)) AND (NOT LEN(a$))             'Print 'til end or keystroke
  509.     LINE INPUT #1, pictureline$                  '  Grab a line of text file
  510.     LPRINT pictureline$                          '  Print it
  511.     a$ = INKEY$                                  '  Check for keystroke
  512. WEND                                             '
  513. CLOSE                                            'Close any open files
  514. LPRINT CHR$(12);                                 'Send form feed to printer
  515. END SUB                                          '
  516.  
  517. SUB viewpicture (monitortype$, n$, scrn)         'View picture
  518. IF monitortype$ = "E" THEN                       'EGA?
  519.     SCREEN 8                                     '  Invoke SCREEN mode 8
  520.     scrn = 8                                     '  Store screen mode info
  521.     columnstart = 275                            '  Set x coord for display
  522.     rowincrement = 1                             '  Set y increment for disp
  523. ELSE                                             'CGA?
  524.     SCREEN 1                                     '  Invoke SCREEN mode 1
  525.     scrn = 1                                     '  Store screen mode info
  526.     columnstart = 115                            '  Set x coord for display
  527.     rowincrement = 2                             '  Set y increment for disp
  528. END IF                                           '
  529. LOCATE 23, 17, 0                                 'Position cursor
  530. row = 0                                          'Initialize row to 0
  531. WHILE NOT EOF(1) AND row <= 199                  'Until end of pic or 200 lines
  532.     LINE INPUT #1, pictureline$                  '  Grab a line from file
  533.     row = row + rowincrement                     '  Increment row
  534.     x = 1                                        '  Initialize x to 1
  535.                                                  '  Find 1st non-blank char
  536.     DO UNTIL MID$(pictureline$, x, 1) <> " " OR x >= LEN(pictureline$)
  537.         x = x + 1                                '    Record its position
  538.     LOOP                                         '
  539.     FOR y = x TO LEN(pictureline$)               '  From there to end of line
  540.                                                  '    Turn on pixel
  541.         PSET (columnstart + y, row), forecolor(ASC(MID$(pictureline$, y, 1)))
  542.     NEXT y                                       '
  543. WEND                                             '
  544. a$ = ""                                          'Initialize to null
  545. WHILE a$ = ""                                    'Wait for keystroke
  546.     a$ = INKEY$                                  '  Grab keystroke
  547. WEND                                             '
  548. END SUB                                          '
  549.  
  550.