home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / turbobas / draw.zip / DRAWDEMO.BAS < prev    next >
BASIC Source File  |  1987-11-23  |  3KB  |  108 lines
  1. '**********************************************************
  2. 'program DRAWDEMO.BAS
  3. 'demonstration of Turbo Basic DRAW command
  4. 'requires EGA or CGA adapter
  5. '**********************************************************
  6.  
  7. CLS : SCREEN 9        'change to SCREEN 2 for CGA
  8.  
  9. 'Loop accepts messages and passes them to subroutine BIGPRINT
  10.  
  11. DO
  12.   CLS : LOCATE 1,1
  13.   INPUT "Enter text: ", MESSAGE$
  14.   IF MESSAGE$ = "" THEN EXIT LOOP     'exit loop if null entry
  15.   CALL BIGPRINT(1, 100, MESSAGE$)
  16.   LOCATE 24,37
  17.   PRINT "HIT ANY KEY";
  18.   WHILE NOT INSTAT : WEND
  19. LOOP
  20.  
  21. SCREEN 0
  22. END
  23.  
  24. '*********************************************************
  25.  
  26. SUB BIGPRINT(XLOC%, YLOC%, MESSAGE$)
  27.  
  28. LOCAL MESSAGE.LENGTH%
  29.  
  30. 'Declare and initialize array.  The array is dimensioned 26
  31. 'elements long with subscripts 65 thru 90, so that the array
  32. 'subscript will match the ASCII code of the corresponding letter.
  33. 'Thus, ASC("A") = 65, and the commands to draw an "A" are in
  34. 'LETTER$(65)
  35.  
  36. DIM LETTER$(65:90)
  37.  
  38. 'DRAW commands for letters A thru Z in order
  39.  
  40. LETTER$(65) = "TA-20 U21 TA-160 U21 D10 TA0 L11"
  41. LETTER$(66) = "U20 R10 F2 D6 G2 L10 R10 F2 D7 G2 L10"
  42. LETTER$(67) = "BU2 F2 R8 E2 BL12 U16 E2 R8 F2"
  43. LETTER$(68) = "U20 R9 F3 D14 G3 L9
  44. LETTER$(69) = "U20 NR10 D10 NR10 D10 R10"
  45. LETTER$(70) = "U20 NR10 D10 R9"
  46. LETTER$(71) = "BU2 F2 R8 E2 U4 NL2 NR2 BD4 BL12 U16 E2 R8 F2"
  47. LETTER$(72) = "U20 D10 R11 U10 D20"
  48. LETTER$(73) = "BR6 R4 BL2 U20 L2 R4"
  49. LETTER$(74) = "BU4 D2 F2 R6 E2 U18 L4 R8"
  50. LETTER$(75) = "U20 D9 TA-35 U11 BD11 TA-137 U15 TA0"
  51. LETTER$(76) = "NU20 R14"
  52. LETTER$(77) = "U20 TA-142 U10 TA-36 U10 TA0 D20"
  53. LETTER$(78) = "U20 TA -155 U22 TA0 U20"
  54. LETTER$(79) = "BU3 U14 E3 R8 F3 D14 G3 L8 H3"
  55. LETTER$(80) = "U20 R10 F2 D6 G2 L10"
  56. LETTER$(81) = "BU3 U14 E3 R8 F3 D14 G1 H2 F4 BH2 G2 L8 H3"
  57. LETTER$(82) = "U20 R10 F2 D6 G2 L10 R4 TA-150 U11 TA0"
  58. LETTER$(83) = "BU3 F3 R6 E3 U4 H3 L6 H3 U4 E3 R6 F3"
  59. LETTER$(84) = "BR8 U20 NL8 R8"
  60. LETTER$(85) = "BU20 D18 F2 R10 E2 U18"
  61. LETTER$(86) = "BU20 TA-160 U22 TA-20 U22 TA0"
  62. LETTER$(87) = "BU20 BL3 TA-170 U20 TA-20 U9 TA-160 U9 TA-10 U20 TA0"
  63. LETTER$(88) = "TA-30 U22 TA0 BL14 TA-150 U22 TA0"
  64. LETTER$(89) = "BR8 U10 NH10 E10"
  65. LETTER$(90) = "BU20 R16 TA150 U23 TA0 R16"
  66.  
  67. 'code begins
  68.  
  69. MESSAGE.LENGTH% = LEN(MESSAGE$)        '# characters in MESSAGE$
  70.  
  71. DO UNTIL MESSAGE.LENGTH% = 0
  72.  
  73. 'get the ASCII value of leftmost character in MESSAGE$
  74.  
  75.     CODE% = ASC(MESSAGE$)        
  76.  
  77. 'convert lower case codes to corresponding upper case codes
  78.  
  79.     IF CODE% > 96 AND CODE% < 123 THEN CODE% = CODE% - 32
  80.  
  81. 'decrement length and strip off leftmost character
  82.  
  83.     DECR MESSAGE.LENGTH%            
  84.     MESSAGE$ = RIGHT$(MESSAGE$,MESSAGE.LENGTH%)
  85.  
  86. 'if not uppercase or space, loop
  87.  
  88.     IF CODE% < 65 OR CODE% > 90 THEN_
  89.         IF CODE% <> 32 THEN GOTO ENDLOOP
  90.  
  91. 'move to start point for next character
  92.  
  93.     DRAW "BM= "+ VARPTR$(XLOC%) + ", =" + VARPTR$(YLOC%)
  94.  
  95. 'if not a space, draw the letter
  96.  
  97.     IF CODE% <> 32 THEN DRAW LETTER$(CODE%)
  98.  
  99. 'next letter will be 25 pixels to the right
  100.  
  101.     XLOC% = XLOC% + 25            
  102.  
  103. ENDLOOP:                      
  104.     LOOP
  105.  
  106. END SUB
  107.  
  108.